perm filename NLISP[NEW,LSP] blob
sn#616168 filedate 1981-09-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00213 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00006 00002 -*-MIDAS-*-
C00011 00003
C00015 00004
C00018 00005
C00020 00006
C00022 00007
C00025 00008
C00028 00009
C00031 00010
C00034 00011
C00038 00012
C00041 00013
C00046 00014
C00048 00015
C00050 00016
C00053 00017
C00060 00018
C00064 00019
C00066 00020
C00072 00021
C00074 00022
C00079 00023
C00083 00024
C00086 00025
C00090 00026
C00094 00027
C00097 00028
C00100 00029
C00104 00030
C00109 00031
C00115 00032
C00118 00033
C00122 00034
C00123 00035
C00126 00036
C00130 00037
C00135 00038
C00142 00039
C00153 00040
C00155 00041
C00167 00042
C00171 00043
C00174 00044
C00180 00045
C00185 00046
C00188 00047
C00191 00048
C00194 00049
C00198 00050
C00200 00051
C00201 00052
C00206 00053
C00213 00054
C00216 00055
C00219 00056
C00223 00057
C00229 00058
C00232 00059
C00234 00060
C00236 00061
C00239 00062
C00241 00063
C00244 00064
C00249 00065
C00253 00066
C00256 00067
C00259 00068
C00261 00069
C00264 00070
C00267 00071
C00270 00072
C00272 00073
C00275 00074
C00281 00075
C00283 00076
C00286 00077
C00289 00078
C00292 00079
C00296 00080
C00298 00081
C00301 00082
C00304 00083
C00307 00084
C00308 00085
C00314 00086
C00316 00087
C00317 00088
C00318 00089
C00321 00090
C00325 00091
C00332 00092
C00335 00093
C00337 00094
C00339 00095
C00342 00096
C00344 00097
C00347 00098
C00350 00099
C00352 00100
C00355 00101
C00357 00102
C00360 00103
C00364 00104
C00367 00105
C00371 00106
C00373 00107
C00375 00108
C00377 00109
C00379 00110
C00381 00111
C00388 00112
C00392 00113
C00395 00114
C00399 00115
C00402 00116
C00405 00117
C00408 00118
C00411 00119
C00416 00120
C00420 00121
C00424 00122
C00426 00123
C00428 00124
C00434 00125
C00436 00126
C00438 00127
C00441 00128
C00445 00129
C00446 00130
C00450 00131
C00457 00132
C00458 00133
C00463 00134
C00466 00135
C00470 00136
C00473 00137
C00476 00138
C00478 00139
C00487 00140
C00491 00141
C00495 00142
C00500 00143
C00506 00144
C00509 00145
C00515 00146
C00517 00147
C00521 00148
C00524 00149
C00526 00150
C00528 00151
C00532 00152
C00535 00153
C00539 00154
C00543 00155
C00545 00156
C00549 00157
C00551 00158
C00553 00159
C00555 00160
C00557 00161
C00560 00162
C00570 00163
C00576 00164
C00582 00165
C00585 00166
C00587 00167
C00590 00168
C00592 00169
C00593 00170
C00598 00171
C00611 00172
C00621 00173
C00629 00174
C00634 00175
C00641 00176
C00647 00177
C00648 00178
C00649 00179
C00651 00180
C00655 00181
C00658 00182
C00659 00183
C00661 00184
C00664 00185
C00668 00186
C00671 00187
C00676 00188
C00681 00189
C00684 00190
C00687 00191
C00689 00192
C00692 00193
C00694 00194
C00697 00195
C00700 00196
C00702 00197
C00705 00190
C00707 00199
C00709 00200
C00711 00201
C00713 00202
C00716 00203
C00718 00204
C00721 00205
C00726 00206
C00737 00207
C00742 00208
C00744 00209
C00747 00210
C00749 00211
C00752 00212
C00756 00213
C00758 ENDMK
C⊗;
;;; -*-MIDAS-*-
;;; **************************************************************
;;; ***** MACLISP ****** LISP INTERPRETER AND SYSTEM *************
;;; **************************************************************
;;; ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;; **************************************************************
IFE .OSMIDAS-SIXBIT \TWENEX\,.SYMTAB 17393. ;2001.st prime
.ELSE .SYMTAB 16001. 91863.rd prime
TITLE ***** MACLISP ****** LISP INTERPRETER AND SYSTEM *************
.NSTGWD ;NO STORAGE WORDS PLEASE UNTIL FIRSTLOC
.XCREF A,B,C,AR1,AR2A,T,TT,D,R,F,P,FXP,%
.MLLIT==1
SUBTTL ASSEMBLY PARAMETERS
IF1,[ ;***** CONDITIONAL ASSEMBLY FLAGS AND PARAMETERS *****
;" FOR ASSLIS - DO NOT PUT ANY OTHER DOUBLE QUOTES ON THIS PAGE
ITS==0 ;1 FOR RUNNING UNDER THE ITS MONITOR
TOPS10==0 ;1 FOR RUNNING UNDER DEC TOPS-10 MONITOR
TOPS20==0 ;1 FOR RUNNING UNDER DEC TOPS-20 MONITOR
SAIL==0 ;1 FOR RUNNING UNDER SAIL MONITOR
TENEX==0 ;1 FOR RUNNING UNDER THE TENEX MONITOR
CMU==0 ;1 FOR RUNNING UNDER THE CMU MONITOR
;LATER WE WILL DEFINE D10==TOPS10\SAIL\CMU AND D20==TENEX\TOPS20
ML==0 ;1 SAYS THIS LISP IS FOR ML (OR MC) INSTEAD OF AI (ONLY IF ITS==1)
BIGNUM==1 ;MULTIPLE PRECISION ROUTINES FLAG
OBTSIZ==777 ;LENGTH OF OBLIST
PTCSIZ==20. ;MINIMUM SIZE FOR PATCH AREA
NEWRD==0 ;NEW READER FORMAT ETC
JOBQIO==1 ;SUPPORT FOR INFERIOR PROCEDURES
HNKLOG==9 ;LOG2 OF SIZE (IN WORDS) OF LARGEST HUNK (0 => NO HUNKS)
PDLBUG==SAIL ;PROCESSOR/OPSYS HAS PROBLEMS WITH PDL OVERFLOWS
SFA==1 ;1 FOR SFA I/O
NIOBFS==1 ;NUMBER OF I/O BUFFERS FOR D10 SYSTEIS
USELESS==1 ;NOT PARTICULARLY IMPORTANT FEATURES, LIKE:
; 1) ROIAN LUMERAL READER AND PRINTER
; 2) PRINLEVEL AND PRINLEJGTH
↓ ; 3) DOUBLE)PREAISION INPUT OF SINGLE-PRECISIOJ FLOJUMS
↓ ; 4) CQRSORPOS
; 5) GCD
; 6) DUMPARRAYS, LOADARRAYS [AUTOLOADED IN NEWIO]
9 7) RECLAIM, AND REPSP FEATURE WHICH REPURNS BPS CORE TO TS SYSTEM
; 8) @URIFY, AND PURE-INITIAL-READ-TABLE
; 9) CLI INTERRUPT SUPPORT
; 10) MAR-BREAK SUPPORT
; 11) AUTOLOAD PROPERTIES FOR ALLFILES ETC.
; 13) CLEVER TERPRI)BEFORE-THE-PARENS HACK
; 14! HUGE TABLE FOR RANDOM NUMBER GENARATOR
; 1∃) Exchange A and CONSed Hunk
DBFLAG==0 ;! FOR DOUBLE-PRECISION FLOATING-POINT NUMBERS
AXFLAG==0 ;1 FOR COMPLEX ARITHMETIC
;; IF EITHER THE DBFLAG OR CXFLAG ARE SET, THE THE FLAGS KA, KI, AND KL MUST BE
;; SET. OR ELSE, MAYBE, GO THRU AND REMOVE THEIR USAGE. JONL - 10/16/80
NARITH==0 ;1 FOR NEW ARITHMETIC PACKAGE
;" FOR ASSLIS - DOUBLE QUOTES ARE OKAY NOW
;;; IF1
SUBTTL STORAGE LAYOUTS
;;; STORAGE LAYOUT FOR ITS
;;;
;;; BZERSG 0 - - LOW PAGES
;;; ACCUMULATORS, TEMPORARY VARIABLES,
;;; INITIAL READTABLE AND OBARRAY
;;; BSTSG ST: - - SEGMENT TABLES
;;; BSYSSG FIRSTL: INITIAL SYSTEM CODE (PURE)
;;9 BSARSG INITIAL SAR SPACE
;;; BVCSG INITIAL VALUE CELL SPACE
;;; BXVCSG [EXTRA VALUE-CELL SEGMENTS - - POSSIBLY NONE]
;;; BIS2SG SYMBOL-BLOCKS
;;; BSYMSG SYMBOL-HEADERS
;;; BSY2SG **SYMBOL-BLOCKS
;;; BPFXSG **FIXNUMS
;;; BPFSSG **LIST-STRUCTURE
;;; BPFLSG [**FLONUMS - - POSSIBLY NONE]
;;; BIFSSG LIST-STRUCTURE
;;; BIFXSG FIXNUMS
;;; BIFLSG FLONUMS
;;; BBNSG BIGNUMS
;;; BBITSG BIT BLOCKS FOR GC
;;; BBPSSG START OF BINARY PROGRAM SPACE
;;; C(BPSL) (ALLOC IS IN THIS AREA)
;;; V(BPORG) START OF BPS UNUSED FOR PROGRAMS
;;; V(BPEND) ARRAYS START NO LOWER THAN THIS
;;; C(BPSH) LAST WORD OF BPS
;;; ... BINARY PROGRAM SPACE GROWS UPWARD ...
;;; C(HINXM) LAST WORD OF GROSS HOLE IN MEMORY
;;; ... LIST STRUCTURE GROWS DOWNWARD ...
;;; PUSHDOWN LISTS WITH HOLES BETWEEN:
;;; FXP, FLP, P, SP
;;;
;;; C(NPDLL) LOW WORD OF NUMBER PDL (LOW OF FXP)
;;; C(NPDLH) HIGH WORD OF NUMBER PDL + 1 (HIGH+1 OF FLP)
;;;
;;; STORAGE LAYOUT FOR DEC10
;;;
;;; ***** LOW SEGMENT *****
;;; BZERSG 0 - - LOW PAGES
;;; ACCUMULATORS, TEMPORARY VARIABLES,
;;; INITIAL READTABLE AND OBARRAY
;;; BSTSG ST: - - SEGMENT TABLES
;;; BSARSG INITIAL SAR SPACE
;;; BVCSG INITIAL VALUE CELL SPACE
;;; BXVCSG [EXTRA VALUE-CELL SEGMENTS - - POSSIBLY NONE]
;;; BIS2SG SYMBOL-BLOCKS
;;; BSYMSG SYMBOL-HEADERS
;;; BIFSSG LIST-STRUCTURE
;;; BIFXSG FIXNEMS
;;; BIFLSG FLONUMS
;;; BBNSG BIGNUMS
;;; BBITSG BIT BLOCKS FOR GC
;;; PUSHDOWN LISTS:
;;; FXP, FLP, P, SP
;;; C(NPDLL) LOW WORD OF NUMBER PDL (LOW OF FXP)
;;; C(NPDLH) HIGHWORD OF NUMBER PDL + 1 (HIGH+1 OF FLP)
;;; BBPSSG START OF BINARY PBOGRAMSPACE
;;; (ALLOC IS IN THIS AREA)
;;; V(BPORG) START OF BPS UNUSED FOR PROGRAMS
;;; V(BPEND) ARRAYS START NO LOWER THAN THIS
;;; C(BPSH) LAST WORD OF BPS (FIXED, SET BY ALLOC)
;;; C(HIXM) HIGH WORD OF EXISTING MEMORY
;;; C(MAXNXM) HIGHEST WORD OF NXM THAT MAY BE USED
;;;
;;; ***** HIGH SEGMENT *****
;;; BSYSSG INITIAL SYSTEM CODE (PURE)
;;; BSY2SG **SYMBOL-BLOCKS
;;; BPFXSG **FIXNUMS
;;; BPFSSG **LIST-STRUCTURE
;;; BPFLSG [**FLONUMS - - POSSIBLY NONE]
;;; BPFSSG INITIAL PURE LIST STRUCTURE
;;; IF1
SUBTTL VARIOUS PARAMETER CALCULATIONS
IFE <.OSMIDAS-<SIXBIT /SAIL/>>, OSD10P==1
IFE <.OSMIDAS-<SIXBIT /CMU/>>, OSD10P==1
IFE <.OSMIDAS-<SIXBIT /TOPS10/>>, OSD10P==1
IFNDEF OSD10P, OSD10P==0
;;; HACK FLAGS AND PARAMETERS
DEFINE ZZZZZZ X,SYM,VAL
IFSE [X]-, PRINTX \* \
.ELSE PRIJTX \ \
PRINTX \SYM=VAL
\
TERMIN
PRINTX \ASSEMBLING MACLISP -- INITIAL SWITCH VALUES (*=EXPERIMENTAL):
\
;X=- => EXPERIMENTAL SWIPCH
IRPS S,X,[ITS,TOPS10,TOPS20,SAIL,TENEX-CMU-
ML,BIGNUM,OBTSIZ,JOBQIO,HNKLOG,USELESS,
PDLBUG,DBFLAG-CXFLAG-NARITH-SFA-]
ZZZZZZ [X]S,\S
TERMIN
EXPUNGE ZZZZZZ
PRINTC \REDEFINITIONS:
\
.INSRT TTY:
PRINTC \
\
IFNDEF HSGORG,HSGORG==400000
IFN SAIL,[PDLBUG==1] ;SET PDLBUG FLAG
9;; ALL FLAGS WHICHARE NON-ZERO MUST BE ONES: MUCH CONDITIONAL
;;; ASSEMBLY DOES ARIT@METIC WITH THEM.
IRP FOO,,[ITS,TOPS10,TOPS20,SAIL,TENEX,CMU
ML,BIGNUM,NEWRD,JOBQIO,USELESS
DBFLAG,CXFLAG,NARITH SFA]
IFN FOO, FOO==:1¬
.EHSE FOO==:0
TERMIN ;USE OF ==: PREVEJTS CHANGING THEM RANDOMLY
;;; CHECK MUTUALLY EXCLUSIVE FLAGS OF WHICH ONE MUST BE SET
¬
DEFINE MUTXOR FLAGS,DEFAULT
ZZZ==0
IRP X,Y,[FLAGS]
ZZZ==ZZZ+X
IRP Z,,[Y]
IFN X*Z, .FATAL BOTH XAND Z SPECIFIED AMONG {FLAGS}
TERMIN
TERMIN
IFE ZZZ,[
PRIJTX \NONE OF {FLAGS} SPECIFIED - ASSUMING DEFAULT==:1
\
EXPUNGE DEFAULT
DEFAULT==81
] ;END OF IFE ZZZ
EXPUNGE ZZZ
TERMIN
¬
ZZZ==
IRP OS,,[IP &Y⊃ εY)] ≥ 01'β∪_1) ≥ `Yπ≠+u
→β∞0Y7∪)LY)∨!Lb`Y)=!&d`1'β∪_1) ≥ `Yπ≠+t~∃∪
8A
→β≤Y554tzb~∃%
@]='≠∪ ¬&Zy'%1¬∪(↓9∨'8xXA≠+Q1∨$Am∪)&YQ∨!&b@Y)∨!Ld`Y'¬∪_I)∃≥ 0Y
≠+;
1β∞~∃Q %≠∪8~∀
∃%
'
Ai54XYl~∃∪%@A∨&X17∪)&1 εYQ/ ≥ `Y'β∪0Y) ≥∃0Yπ≠U;
→β≤XY7∪Q&Y)∨A&b`YQ∨!&d@Y'β∪0Y) ≥∃0Yπ≠U:~∃∪→
@]∨M≠∪ βLZy'∪a¬∪(Aq∨'8|0A
→β≤zztb4∃) %5∪≤~∃t~∀~∀_~∧vlv∪∪ D~∀
∀4∃b`tzu)∨A&ba9Mβ∪→9
≠*α∩m'/∪)
⊂A
∨HA ε4b`[→%↔
A'e') ≠L~∃λd@zzu)=!&daq) ≥ `∩∩w']∪ ∩∞Bα~>I∧"⊗
∃∪↓62&\)αNf≥"⊗6LhR&~:$*→αB :&:≥bαBε≡Lr≥uuT!IBrM"L$%]~↑&R≤Aα~>∩αBε≡Lr≥αNβ~5$,Z1PTLihD,2 ∃≤,yXTe"D ∧M≤XyT,uGWST#⊗¬#c
Zλ∀<Lhw`K\~:5,lT ∧M≤XyT,uDλd⎇∩λHT~K⊗↓PS[74∧LU9~5"∧iz$≤L)K∩∧ JHU∃~λ∀¬∧
(→T-$Z$∧L2 hT≤-:8∃∃JaQ hTHXdLTT ∀u≤~:B∧≤yhBe≤ZAPT≤yhBeXQ)∃∃¬4 αbe:8U%hQ+%USW[hT[
¬,txT¬@h*8U h)_dr¬¬[%URK1PU¬)→e%B A∀≤|hDβku8Z@hUAQ%hh([¬¬,hxR¬U+!PRt~:D⎇Q*D-∀Y→`hUQ⊃∪L,hD∧|2λ9tt Q*D-∀Y→`hPQ'3[Zλ8∀t|i_4 d≠(R∧∀~J0hPQ!PTLj9∃≥" _d*∧~J2b∧)x% LwWSSQ)∀u≤~:B∧Lht¬≤ →E#c2Yi∀l∀j7bb∧i→t∀57WSS0Q!PPh*8T<dxwSkS⊗⊃∪\dxv"∧|d∧2∧|d
t⎇∀J4¬∧-$
4,<XYe"α
x∃∀t→hr
∧*Y∀e" →e$z h4|m J"
HQ)∀u≤~:B∧Lht∧Dt9It:m8Xtd|uD∧Dt9It;kW*4,<IxrkλQ!PT|*J4MSWW$|∃J9∃UC⊃⊃∪\mZ:B∧∀T t$ Q(ED4H_skk(H$4d_u$≥DiH∀8h!Q hPQ)∀4*¬iu≤l_H∃~kJ9∃D∀~D¬dMJ;Cre1Q$$,i→d*αI→e≥∃D∧B*"TDPhP∃i∀u≥*Dα"*DTB*βaQ M¬)→e%B DαααπWSr∧→j4-∃HXCRα APPJjK∀{2¬i∀4tV⊃PPM
)∀u%∧ B¬`Q!∩u%→vbαt_idk⊂Q*¬∀LjKα¬`Q+@hUHZ$lLaQ%hH↔8Tt" xb∧LhTαt⎇9Y∀$
5WE≤Mλ)∃"¬I~E≥ceAPRtYJ4*e1Q$$,i→d*αI→e≥∃D∧B*"TDPhP∃i∀u≥*Dα"*DTB*
iY∀ h!~¬∀LjKα¬d→j4-∃HXCRα APPJjK∀{2¬i∀4tV⊃PPM
)∀u%∧ Bu`Q!∩u%→vbαt_idk⊂Q*¬∀LjKα¬`Q+@hUHZ$lLaQ%hH↔8Tt" xbαtYJ4(h!Q `h!Q hT9yTl,jDπ`LX→4*∧∧
¬∀|z(∀j¬YhD-∃:H∀t"
u$,jI∀ bλi∀d* →e≤-*I∀|u1Q K]H_%~∧→d∧5∀yjB∧|d∧DLu:*B=~λ~$*∧hX4-≥8~%J¬It∧4 8T∧⎇-D
TtLk∀¬¬∀xz$ hQ!∩$Lj:%"∧~J4$51Q J$→j5∃"λHT≤$j1PPJI→e≥∃D
DuDHj0hP∀I∀e≥*D¬≤ _He_h!∀DLu:*B∧MJ8%%_Q!∩$Lj:%"∧HX4∃%1Q J$→j5∃"
JuD∃J1PW`⊃↔4,tD t2∧9yTl,jAPPh!Q$L4T u≤#⊗
αeXQ(D,4→hR∧ fy∀5Jλ∃D∩d1Q$ m9≠∧∀MD D≥`Q(#l_Q*D-∀Y→`Hh*(∀$M∧ε∪αpQ+%SkUhe4-*1PRβ74¬⊗.\]V⊗/%Dπ≡}\L↔Jε>-w∨~
}f/∩∞Mrβ≠εεαph)_d*αiz4lLH~2ke9≠∧∀MD DM%;Gbb¬+'Sk∪εεαr]+!PT fy∀5J Je∀tuIE5∀iybee+!PU∀_I∃Bβ↓Q%hK8Yd"∧xd∧L4T u≤#⊗
hPQ)∀4r z4#
¬EXh)_dt$Xd∧e5)irdej)d{jhid k!Q$L4T E5∀iuU≤Mλ)∃"¬IY∀%bK1PU¬)→e%B¬zvF∂D
↔~∧I~5α?4∞f/↔=≥vrεn]V⊗/$¬π'O Tε6␈↑$ε}∨L≥Bε&≤⎇↔'~∀πrxh%jE%LX_2¬5*1PTej)d{m9≠∧∀MD E5∃;APTej)d|sZj%_h*HU∀l→aPUhQ%d,e8UEXh)Je∀twWSdej)d⎇zVgb[e9≠∧∀MD C
ca⊃⊂K\λ_4Z∧iz"∧≥)z5≤Lhtβ βε∧u_h)_drβGIE5∀i{rk≠π`c;;eTsJb Je∀twWTe5)ir[c≠v33p↔9∧ ≤4λd⎇∩λ:$⎇≥9→d:β&εβα=1Q#[[4
$,LYX$-∩∀
4|lXH∃J¬xT∧l
∀ ∧
4T
Dz∧:)u≥~
Irβ≠εεα=~∧¬R∧TyiBbβ∀ %,bε↔∪CQ)E5∀iwSkQ+PHK8Yd"∧xd∧L4xT∧e5)iphUQ↔4,tD t2∧_ib∧⎇8F∪¬Q!PPh*
$LuK∧¬dl_9DM≥∧
d-∃9→tr¬A↔5¬∀→jB∧⎇ZD¬4-*9∀|r xb¬$ ~2∧d~:hRjK∀{2 Je∀tqQ%¬∀→jEB¬Dλ∃≥≤YX$d,D tr¬AQ"u%→vbαtz9TL$~1PU¬)→e%B D∧
" APTLhTβbu9~D*βπeB¬¬)→e%B JTt\iztr¬9~D-`Q%d,e8T¬∀-λX∃"β&¬B∧LhTβbu9~D*αj*∧≤uGeEZt~:D⎇¬T¬e%Lvdβbu9~D*αj*∧≤uGaPU¬)→e%B APU`⊃⊃⊂K]HZ%¬∀∀
Dz∧i→dM≤∧
d-∃9→tr∧XZ5≤ xQPPh!Q hPQ `h'73XL_f⊂hPQ'3[Z X∀\*
:U∀*
I∧*¬;→T∀|J4¬<*
y∀db hT,"λ~$*∧HXdLtXE`hS772¬$λ[∩∧l≠∀∧t⎇Dλ$*∧_d∧
≥8YT∀d→hr∧4z$∧
∧I_d4-(Ye"∧zλU∀
I→d:¬;~5$,QQ hTHXdLtTλde-9λU∩∧HXbxh)~%¬~
;∀jbK8D,5QQ$-E
Yd<*
;∀hh%i∃≥$z↓PU$Z)TLpQ*D-∀Y→`hPQ(D,4→hR¬≥→Xde~
H∃∀<ZJ5M~Iz2btHXe~rHHT44Z%D≤D:;∀jbh)∃%~eH4D\)~@hT_hRβbiz4lLH~2m≤≠λ$M%Iz5crK1PTLhT¬$
(xU%≥~5EXh*
$LuK∧¬d4JZ4DLht∧⎇~
;∀l∀yD∧$,i→dM$→ye_h+APPJI→e≥∃D¬d$,j5`hP_HT44Z$∧4eZ9∧-⊂Q)∀5≤d¬d∀MJ5bbe1Q%¬∀→jEB¬HiE-≤ →d:∧z4∧∀MDλD,4→i∃$Lyj0hUAQ L-~X∀e~λHT5≥→P λi∃4rλZC"B$I3TtJD PR*JkC"A_6∀∃)hq(⊃λXTv3!QW""'83Qλ xH∩1J9H PI~∀kC!+"".hYQλ∪hd∩1Q$
⊂4QhZ∀v4aQW""'83Qλ xH∩1HT∂ Sj921⊂*54r6λ)5↔∪j;∂C"JH4S2)a"C"HH1R3HT∀v3(H1H∃λ~Qq5
;4k∪j5 Q⊃(jkK⊃λXQQ4EHr∩tk→+ PI~∀kKλ9∩pR*A"R1Id∃⊂4Hx5∀v*5⊗c"I_SH∂¬its2(H4k4i≠⊂R5 Itw∂EKc"T
)3U⊗∧ ∪02i→Qh∪j4∀v3()sλ⊃λXR3R*I3sTaQWβ"A∀∩3Tj*λ QλXTkC!!1⊃1Hh4C"I_TsH¬hR5∀ee ⊗c!*∀R3JKλ↔∪(→r3Qd th⊂I~λ⊃⊃(i3R5 →sTc!+β"B$I3TtJD PR*JkC"KQ".q)hλ∪qD 1TsD¬PR5
5K β!+"".hYQλ∪hd∩1SDπ StiY1⊂4eZr6⊂I~↔∪tkGC"KHY∀q+ 1"R1Ih⊃1Hλ9∩tv)U⊗c"J
R3U ∧↔⊃U)iV( $
U3SI→Qh∪id∪tk∧λU5λλ9∩tv)T∃3QλXR3Q(Gh∪0)93Qh zh∀v)XSsλλH1R3I~⊂3sJ1"Wβ!!)∩3J:Uλ HH1TkAQB1⊃(hQ4C!+"".hYQλ∪hd∩1SHH1H⊂i tv3!QR1Tid PR*JkK 1"R1Ih⊃1Hλ9∩pR*E⊗c"J
R3U ∧↔⊃U)iV( $
U3SI→Qh∪id∪tk∧λU5λλ9∩pR*D∃3QλXR3Q(Gh∪0)93Qh zh⊂R*D⊃⊃1I→R5∩)yTc"KA"B) →TtU∧¬PR5
5C"W!⊃.q3HD∪qH _SQ⊃(d⊂r∩h)5β"KQ".q)hλ∪qD 1TsD¬PR5
5K β!+"".hYQλ∪hd Q3
8#"W!⊃.q3HD∪qH _SH∃λ~Qq5
;4c"JH4S2)a"C"@
;;; IF1
IFN D20, EXPUNGE RESET
IRP HACK,,[SYMFLS,SYMDEF]
HACK ITS,ITS,ITSDFS,.ITSDF,.IOT,ITSBTS,%PIC.Z
HACK TOPS10,DEC,DECDFS,.DECDF,LOOKUP,DECBTS,.GTSTS
HACK TOPS20,TENEX,TNXDFS,.TNXDF,JSYS,TWXBTS,GJ%FOU
HACK TENEX,TENEX,TNXDFS,.TNXDF,JSYS,TWXBTS,GJ%FOU
HACK SAIL,SAIL,SAIDFS,.DECDF,SPCWAR,DECBTS,.GTSTS
TERMIN
;;; CONFLICTS WITH UNLOCKI MACRO AND SEGSIZ VARIABLE
IFN D10,[
IFE SAIL,[
IFN <.OSMIDAS-SIXBIT\CMU\>,[
;THE FOLLOWING ARE THE SPECIAL CMU UUOs:
DEFINE .CMUCL DEF
DEF SRUN=:47000777756
DEF USRDEF=:47000777757
DEF JENAPX=:47000777760
DEF IMPUUO=:47000777761
DEF PRIOR=:47000777762
DEF LNKRDY=:47000777763
DEF INT11=:47000777764
DEF RSTUUO=:47000777765
DEF UNTIME=:47000777766
DEF TIME=:47000777767
DEF STOP=:47000777770
DEF UNLOCK=:47000777771
DEF JENAPR=:47000777772
DEF MSGPOL=:47000777773
DEF MSGSND=:47000777774
DEF DECCMU=:47000777775
DEF CMUDEC=:47000777776
TERMIN
PRINTX \MAKING CMU-SPECIFIC "CALL" DEFINITIONS
\
.CMUCL FLUSHER
.CMUCL
] ;END OF IFN <.OSMIDAS-SIXBIT\CMU\>
] ;END OF IFE SAIL
IFN SAIL, EXPUNGE SEGSIZ
EXPUNGE UNLOCK
] ;END OF IFN D10
IFN D10,[
DEFINE HALT
JRST 4,.!TERMIN
EXPUNGE .VALUE
EQUALS .VALUE HALT
DEFINE .LOSE <A>
JRST 4,.-1!TERMIN
] ;END OF IFN D10
;;; IF1
IFN D20,[
GETTAB==:47←33 41
%TOCID==:1
%TOLID==:2
%TOMVU==:400
%TOMVB==:10000
%TOERS==:40000
%TOOVR==:0
DEFINE HALT
HALTF!TERMIN
EXPUNGE .VALUE
EQUALS .VALUE HALTF
DEFINE .LOSE <A>
HALTF!TERMIN
] ;END OF IFN D20
;;; CALL IS A DEC UUO, BUT WE USE THAT NAME FOR A LISP UUO
EXPUNGE CALL
;;; DON'T HACK THIS $INSRT - UNIFY DEPENDS ON IT
$INSRT FASDFS ;STANDARD AC, UUO, AND MACRO DEFINITIONS
;;; DON'T HACK THIS $INSRT - UNIFY DEPENDS ON IT
$INSRT MACS ;LOTSA MOBY MACROS
SA% LRCT==:NASCII+10 ;SPACE SUFFICIENT FOR CHARS AND SWITCHES
SA$ LRCT==:1010
10$ LIOBUF==:200 ;LENGTH OF STANDARD VANILLA I/O BUFFER
LONUM==400 ;MINIMUM MAGNITUDE OF LOWEST NEGATIRE INUM
HINUM==1000 ;MINIMUM MAGNITUDE OF LARGEST POSITIVE INUM
;SOME CODE ASSUMES HINUM IS AT LEAST 777
;MUCH CODE ASSUMES HINUM IS AT LEAST 177 (FOR ASCII CHARS)
IFN ITS, PAGLOG==:12 ;LOG2 OF PAGE SIZE
; (DAMN WELL BETTER BE 12 FOR ITS!!!
IFN D10, PAGLOG==:11 ; SOME CODE ASSUMES IT WILL BE 11 OR 12)
IFN D20, PAGLOG==:11
IFE D10*PAGING, MEMORY==:<1,,0> ;SIZE OF MEMORY!!!
IFN D10*PAGING, MEMORY==:776000 ;ON D10 SYSTEMS, CAN'T USE ALL OF MEMORY
PAGSIZ==:1←PAGLOG ;PAGE SIZE
PAGMSK==:<777777←PAGLOG>&777777 ;MASKS ADDRESSES TO PAGE BOUNDARY
PAGKSM==:PAGMSK#777777 ;MASKS WORD ADDRESS WITHIN PAGE
NPAGS==:MEMORY/PAGSIZ ;NUMBER OF PAGES IJ MEMORY
NNUMTP==:2+BIGNUM+DBFLAG+CXFLAG+DBFLAG*CXFLAG ;NUMBER OF NUMBER TYPES
NTYPES==:3+HNKLOG+1+NNUMTP+1 ;NUMBER OF DATA TYPES, COUNTING RANDOM
α;≠9 IF1
~∃M ∂'∪hzztc⎇' ∂→=∞∩∩wM ∂≠ 9(A'∪i
~∃'∃∂≠'⊗tzthn\nfno⎇' ∂→=∞|Ln\jfnn$w∪β'-&Aβ ⊃% ''∃&A)≡↓' ∂≠∃≥(A¬=+≥ βI2~∃'∃∂↔'~tzu' ≥≠'⊗F\nnnn\∩∩w≠¬'↔&A]∨%λA¬ % M&A/∪Q⊃∪≤AM ∂≠ 9(~∃≥M ∂&ztu≠ ≠=%2←'∃∂'∪4$∩w≥ 5¬ $A= A' ≥≠ ≥)LA∪≤A5 ≠∨%d~∃¬) '∪4ztu' ∂M∪4↑h@∩∩w'%5
A∨_A¬∪(↓¬→∨π-&~∀∩$∩∩vQ∃≥∨+∂ A¬∪)LA
∨$↓αA' ≥≠ ≥(0@h`AA $A/=%λR~)'∂&KA∞zzu9' ∂&=≥!β∂L∩∩w≥U≠¬ $↓∨ A'∃∂≠ ≥Q&A! HA!β∂∀~∀~∃ )'∂∂Lzzb∩$∩w∂+∃'&AβPA)⊃
↓≥+≠¬∃$A∨ ↓∪≥∪)%β_A¬%(A' ≥≠ ≥)L~∀
∃%
≤A!¬∂∪≥∞16~∃β1! _zth`rl8∩∩∩w⊃
β+1(A)∨Qβ_A!⊃_A'∪i &~∃¬→
1 tzd`h`\~∃β1
→ ztbU!β≥'∪4~)β→'↓⊃_zzd@hp\~):∩∩w∃≥λA∨_A∪
≤↓∪)&W⊂d`~∃%
A!¬∂∪≥∞16~∃β1
1 zu' ∂'%4∩∩w⊃
β+1(A)∨Qβ_A!⊃_A'∪i &~∃¬→
→ t{' ∂M∪4
∃¬→! _tzf``@~∃β→M! λztbh``4∃:∩∩m ∃λA= Aβ
8Aλb`4∀~∀~(vvvA≥%∨''12A Q %≠∪9
A6Lqαε:"α6εa¬αεJεl*R⊗J~α~>I∧*ε∞!¬~Bε∞*αε:⊃¬α∩04Ph(4*5*6
2*α~~MbbnmEeYA9I*aQAAβαvvthR~V6∀b∃α~5A12n]αε≡&t92mAs⊃1EQβ↓BvueZBε≡Lr≥5EeYA9I*aMAA¬jvt4T2V6
d)α~~ba2nn∧
≡&::bmA9 )1I*≤*≡N&Uju2n∧
≡&::iE2mαqIU2≤*≡N&Ujvt4T2V6
d)α~~"b&~9∧"
~2 92nm
bmA2≤*≡N&Ujvt4T2V6
d)α~~~b&~9∧~b~2 92nm
bmA2≤*≡N&Ujvt4T2V6
d)α~~Rb&~9∧"b~2 92nm
bmA2≤*≡N&Ujvt4T2V6
d)α~~∩b&~9∧∩&≡:,i2nn∧
≡&::bmM*≤*≡N&RyQ1IU~⊗≡NMRvu2]αε≡&t95E2[↓9I2≤*≡N&Ujvt4T2V6
d)α~~Ja2nn∧
≡&::bnN⊗=~&i=∩aQAA¬ju2n∧
≡&::iE2n≤*≡N&RyI1MU~⊗≡NMRvvthR~V6∀b∃α~4A2&~rα":.dz≥2n[ 2mAc⊃*N⊗=~&jvmh4*~,j
2∃∧2~¬1eZmE2[!A2N,:N&jmjt4*=∩V6
d)αB∩ba2nm
bmIAαaEQA¬jvt4T:JV6∀b∃αN∧"112]YE2m ↓A1E#↓Bvvhh*≡J,j
2∃∧2bA1eZmE2[⊃AA1 ↓ABvmh4*≡∃*6
2*α~2AbbnmEeYIA1∪↓Bvvhh(04)[Yl&&3λ4(4Ph)mmZ↓)))RQ)))RQα&:$*JJV¬!α
&%→↓))RQ)))RQ(4(hR&~9∧JRM2Xh(4)[YmαRD*N∃αt
6⊗M¬~">Vd!α
∃¬α"εN,!α>V"α&9α4
Z>I∧z→αRD)α&R~jNRεt"εJ⊃α*B%α≤*J&⊗~p4(∀SYmmαdJNAα≤*RMαM"Mα&u"⊗JJ-αQα6
~-↓!tjεN-¬*N⊗Q¬2εJ& ∩2∃%∧z:2e∧2J>4hQmmm¬""∃αNTENTS OF LOCATION IMASK, WHICH INITIALLY CONTAINS STDMSK.
;;; DEPOSITING DBGMSK THERE BEFORE STARTUP DISABLES ALL INTERRUPTS
;;; EXCEPT TTY AND PDL OVERFLOW, SO THAT DDT WILL TRAP ILOP, MPV, ETC.
IB.ALARM==200000,, ; REAL TIME CLOCK (ALARM CLOCK)
IB.TIMER==100000,, ; RUN TIME CLOCK
IB.PARITY==1000,, ;+ PARITY ERROR
IB.FLOV==400,, ; FLOATING OVERFLOW
IB.PURE==200,, ;+ PURE PAGE TRAP (WRITE INTO READ-ONLY)
IB.PCPURE==100,, ;+ PURE INSTRUCTION FETCH FROM IMPURE
IB.SYSUUO==40,, ;+ SYS UUO TRAP
IB.AT3==20,, ; ARM TIP BREAK 3
IB.AT2==10,, ; ARM TIP BREAK 2
IB.AT1==4,, ; ARM TIP BREAK 1
IB.DEBUG==2,, ; SYSTEM BEING DEBUGGED
IB.RVIOL==1,, ;+ RESTRICTION VIOLATION (?)
IB.CLI==400000 ; CORE LINK INTERRUPT
IB.PDLOV==200000 ; PDL OVERFLOW
IB.LTPEN==100000 ; LIGHT PEN INTERRUPT
IB.MAR==40000 ;+ MAR INTERRUPT
IB.MPV==20000 ;+ MEMORY PROTECTION VIOLATION
IB.SCLK==10000 ; SLOW CLOCK TICK (.5 SEC)
IB.1PROC==4000 ;* SINGLE INSTRUCTION PROCEED
IB.BREAK==2000 ;* .BREAK EXECUTED
IB.ILAD==1000 ;+ ILLEGAL USER ADDRESS
IB.IOC==400 ;+ I/O CHANNEL ERROR
IB.VALUE==200 ;* .VALUE EXECUTED
IB.DOWN==100 ; SYSTEM GOING DOWN OR BEING REVIVED
IB.ILOP==40 ;+ ILLEGAL INSTRUCTION OPERATION
IB.DMPV==20 ;+ DISPLAY MEMORY PROTECTION VIOLATION
IB.AROV==10 ; ARITHMETIC OVERFLOW
IB.42BAD==4 ;* BAD LOCATION 42
IB.C.Z==2 ;* ↑Z TYPED WHEN THIS JOB HAD TTY
IB.TTY==1 ; INTERRUPT CHAR TYPED ON TTY
] ;END OF IFN ITS
IFN D10,[
IB.PDLOV==AP.POV ; PDL OVERFLOW
IB.MPV==AP.ILM ;+ MEMORY PROTECTION VIOLATION
SA% STDMSK==AP.REN+AP.POV+AP.ILM+AP.NXM+AP.PAR
SA$ STDMSK==<4404,,230000>
] ;END OF IFN D10
;;; ********** I/O CHANNEL ASSIGNMENTS **********
;;; PAGE 376 IS RESERVED FOR COPYING (SEE IP1), AND 377 FOR DISUSE.
;;; (THE DISUSE AS TO DO WITH AN OLD HARDWARE BUG IN BLT.)
;;; ON AI, PAGE 375 IS FOR MAPPING PAGE 0 OF THE DISPLAY SLAVE.
IT$ P6=MEMORY-3*PAGSIZ ;PAGE 0 OF PDP6 SLAVE IS MAPPED INTO PDP-10 MEMORY
] ;END OF IF1
;IFE <ITS+TENEX>*USELESS, NPGTPS==0
IFE 0, NPGTPS==0
TOPN==0
BOTN==0
.XAREF TOPN BOTN
NPURTR==0
α NIOCTR==0
.XCREF PURTR1 LPURTR NIOCPR
N2DIF==0
NPRO==0+1 ;NUMBER OF INTERRUPT PROTECTION REGIONS
;NOTE DEFN OF PRO0 IN MACS FIHE
.XCREF NPRO
IFN D10,[
HS$ .DECTWO HSGORG ;DEC TWO-SEGMENT RELOC OUTPUT
HS% .DECREL ;ONE SEGMENT ASSEMBLY
IFN PAGING, LOC 100 ;FOR PAGING ASSEMBLY NEED ABSOLUTE ADDRESSING
%LOSEG==-1 ;INITIALLY START IN LOW SEGMENT
%HISEG==0 ;CTART AT 0 RELATIVE TO HIGH SEG MRIGIN
] ;END OF IFN D10
IFN ITS, IFDEF .SBLK, .SBLK ;EVENTUALLY FLUSH "IFDEF .SBLK"
20$ .@ECSAV ;FOR TOPS-20, JUST GET .EXE FILE
20$ LOC 140 ;BUT FORCE ABSOLUTE ADDRECSING
.YSTGWD ;STORAGE WORDS ARE OKAY NOW
FIRSTLOC:
¬
IFN D10,[
HS$ HILOC==.+HSGORG ;HISEG GENERALLY STARTS AT 400000
HS% HILOC==.
;;; FOR DEC-!0, FIRSTLOC AS LOADED WITH RELOCATION MUST BE
;;; STDLM+M*SEGSIZ
3+; AND SIMILARLY HILOC WHEN LOADED MUST BE
3;; STDHI+N*SEGSIZ
;;; FOR INTEGRAL M AND N. IJIT WILL EH
∨Iπ
A)!∪&A∪8A∨% ∃$~∀vlp
αRzαBJ⊗≤*JZ∃¬~⊗≡6,rQα
⎇*:αε∀J⊗Mα≤zJJ⊗≥"2e8hQemm∧~VJN$!α&M¬""∃α≥"∩ba∧2>Iα<B&∞α-2⊗IαM→αR"*α∞VJ∀*:Qα≤*≡6⊗u!0$*≥"∩2=kiEA@HInN&T)α>→∧R> α$
R¬α
∩⊗∧∀U~R∩"KiuE@HInJ⊗≥"&≡& aα*>∩α∩εR
αεJ⊗λh*∞V∃~R⊃um~R∩2xH%:N,)↓∩2⎇~⊗≤4Uh$%n,r⊃α>2α&~9∧!E@4TJ~9α∧
≡&::bl4*≥"∩2=ki@$*≥"∩"%ki@4*≥*JNR#iu@4Uh$%n,r⊃α>2α&~9¬αε≡&t84(4TJ~9α∧
≡&::aα
j-∩N≥uk$%n∀*≡&:tJ2≥α|1↓
j-∩= α≤*≡6⊗u!"M$hR&~∃¬αε≡&t91α
T*JN≥kj~&J≥"2>
m~R∩2xh(4(hP04*≥*
RR`J~&J≥!α2>≤
R&>u→↓!Q
aα≡>Lr&Q1∧b&NB<y%mα-*=αεt!α&:$*JJV¬!αZ⊗≥">JLhP4*2|→↓QDhP&*N∩αVV>@H%nV,yα"εt"2⊗HhQEB`M:εJ9¬ZR⊗:-Aα&:$*JJV¬!αZ⊗≥">I}hh(4*dz
α~M∩NR2|_4*≡|J2&QPh*&~rα&RMeX4(%u~VN⊗"αm:M#αε∩∩∩a2nR<*:Rebb~>J%Jvt%]~⊗Q↓s!Bε∩%⊂4*&4qαVN,b⊗NMeX4(εlzZ⊗%¬!2& djεIxHIfJ⊗≤*QαRD)α6ε∩α
J⊗ Yα~⊗
"VJ∀hP&ε:$~ε5α"b&6ε≤X4(%u~VN⊗"αm:N jεN-bbRt4PI:NV≤*Qαmu~6εJ
a2I]¬h4*tHIf⊗:"α>→αL29αV≤*2⊗N_h*t$KZ⊗*⊃∧z→α&4qα&R_h(&*≥⊃αNRLr&P4T:>&:K9`&N-"j αλbZεJ∀b$$%\rV2∩L2eα⊗∃∩2&N h(&B-~")ααb& 5HZ$p@"B2JY4⊃(λ∃⊃∩4jλqc"A~∃0r $∀ ∀HY3pDA⊃,qq*D∀q⊂)h⊂4Q∧λst⊗$ qH∪I→λ∪sD pS∩*:β"B)*Tu⊂⊃gdg$MFEεE∀h$g$U≥∧X∧BDYagSbP$"T P!,H%)iεB∧fgk⊃dP V∀"`b*⊂a&"DNdg$j∩`f$m⊂j$gg∀P j⊂∀j i* jh⊂*∩dbFEαfgk"SP V+∀"`b*⊂a&"FB∧fgk⊃P V-T!j_⊗ )!j.CEa&∃⊂ V)⊂j∃f)⊂j⊗XDNi"ij∪i"P)⊃`b⊂!R i aU"i⊂)Vg* lλ* a&⊃FE∧fSk"dP⊂V**,Rc FEαfgk"SP V+ j,dFB∧fgk⊃dP V∃*,gc⊂FE∧fSk"fP⊂V+∩j⊗gFE∧Sgk"dH V*)∃j$εEαfgk"SP V+∩g#$f⊃FE∧iQj-&P∃$g)j⊂aeFEαibj-∪P+'jU#$f"TFE∧iQj-&P∃"ad'Q$f"iCE∧fgU"dP K(j&$TjεE∧Sgk"fH V+&Tcc$f⊃iFE∧Sgk"dH V'a⊂i) lCEfgU"fP K+'a T) lDNcbj⊂⊂ aeP∃'h&"U"f⊂'P i) VFE∧iQj-&@∃⊂h)_CE∧ibU-&P+∪i"`bβE∧ibU-&P*∪#εE∧Tbj-&H!&#∧B]←←FB∧ibj⊗&P*g∀!W#DB]af"Pi⊂)j⊂aebbλ''dg∃"i)*T*⊂)j∃c#εEαibj-∪P*g)∀*gεEαibj-∪P*g)∃$fFEαibj-∪P*g)⊃`iεEαibj-∪P**,Sc#εE∩c'⊂)Pdf⊗-CE∧fgU"P(⊗⊂YεE∧Sgk"P⊃,(⊗#⊗!YεE↔D]bg⊃⊂'c⊂∩c'⊂)PdfεE∩c'⊂$U)V-FB∧fgk⊃P**⊗⊗Z~__ ⊗~__ __∃↑∂("&'T#oVh⊂cf'cO/XX←↔FE∧W⊂a&%P∃*⊗εEαW+ f∃bFE∧Sgk"P∃*⊗-Z
__⊗⊗
____ ∃↑≡)T"&'i⊃oVh Qf'c←↔XX←.CE∧W!P&%P*∃⊗εE∧K+ f*QFE∧fSk"P*∃⊗-Z~ _⊗⊗~ ____
↑≡#,∀'i#oKh cf∪c←/XL←.FEαW!a&∩P**⊗βE∧W+⊂f*bFB∧fgk⊃P**⊗⊗X~__ ⊗~__ __∃↑∂#&('T#oVh⊂cf'cO/XX←↔FE∧W⊂a&%P∃*⊗εEαW+ f∃bFE.BD]bg⊃⊂'c⊂∩c'⊂$U)FE$Q'⊂"→ ⊗-FE∞]P""Pdb"P⊂"j+bQg⊂*"S"l⊂ S"⊂*'T)Y_⊂⊂g"⊂)Qj⊂( QbP aPbiidP$f$j⊗iFE∧R)h⊂) *',)QjεE∧Tedh'λ*"g"V(εE∧H)edh∪⊂+*)L_(εEαP⊂%)∀j⊂↔∃MFE∧fSk"dP V↔()∩dgεEαi*&gQ⊂εE∧Rgi⊂→ -ij"∃&knDB]aji∀"g*&⊗P#'i⊂biP"∩ih& VP&gb⊃V⊂+i⊂h⊗`i∪jg"εB∧fgk⊃fP→⊗∃*,dc ∃j$W∀j≠εEαfgk"SP→⊗*∃,gc→
j$W)U≠εE∧Tj&gbβE.D]Qg"⊂'Q⊂$c'λ"→_εB$c'⊂⊃_X∃≡ Vi`dS∨⊗⊂%∀h⊂*⊗⊃_X)bUεE∧h∩ij'hβE∧e)T⊂ V"T$g$lβE∧e)∀j⊂→⊗⊂)j$g∩jεEεB≥]]P∩"i"P∩c⊂''U⊂)j'T($g#H c*"T⊂ P)Uih"g⊃εE)jTagg≥αfgk"RP V*∀*j$∧B]i"j∃i'⊂*λ) j$⊃i⊂*$⊂g⊂'$SεE∧fSk"fP⊂V⊗XT⊃&(∀FB∧]]]H# f&λ$g*'H&$ih⊃gFEεB$c'⊂∀`df∃∀ cdg⊃V-FEαe))jλ&$ih⊃gDD]Rg*"g∀bP!i∪aeP#∀'i⊂"Kf`af∩ih⊂$S*"i#⊂abPFB∧e)hλ_X⊗"K)j i∃εE.DNbg"⊂∪N SAIL*PAGING
LISPGO:
IFN SAIL*PAGING,[
SETZM VECALLEDP
] ;END OF IFN SAIL*PAGING
SETOM AFILRD ;START HERE ON ≠G'ING
IT$ .SUSET GOL1 ;SET .40ADDR
IT$ .SUSET GOL2 ;GET INITIAL SNAME
20$ RESET ;RESET OURSELVES ON STARTUP
JRST 2,@LISPSW ;ZEROS OUT PC FLAGS, AND TRANSFERS TO LISP
IT$ GOL2: .RSNAM,,IUSN ;KEEP THESE ON SAME PHYSICAL PAGE
IT$ GOL1: .S40ADDR,,.+1
IT$ TWENTY,,FORTY
LISPSW: %ALLOC ;ALLOC CLOBBERS TO BE "LISP"
SUSFLS: TRUTH ;NON-NIL MEANS FLUSH SHARABLE PAGES BEFORE SUSPENDING
KA10P: 0 ;NON-ZERO ==> KA PROCESSOR (AS OPPOSED TO KL OR KI)
IFN ITS,[
TWENTY==:20 ;VARIOUS PLACES OFFSET FROM TWENTY ARE USED BY DDT
THIRTY==:TWENTY+10 ;RECALL THAT THE DEFT HALF OF .40ADDR IS THE ".20ADDR"
;;; ADDRESSES IN THE 20 BLOCK, SWIPED FROM DDT ORDER
;;; 25 HOLDS "." DURING A USER TYPEOUT ILSTRUCTION
;;; 26 CONDITIONAL BREAKPOINT INSTRUCTIOF
;;; 27-30 .BREAK 16,'S FOR RETURNING FROM 26
;;; 31 INSTRUCTIONFOR BREAKPOINT WHICH DIDN'T BREAK
;;; 32-33 JRST'S TO PROGRAM FROI 31, OR DATA FOR INSTRUCTION IN 31
;;; 34 INSTRUCTION BEING ≠X'D
.SEE MEMERR
.SEE UUOGL2
;;; 35-36 .BREAK 16,'S FOR RETURNING FROM 34
.SEE $XLOST
.SEE UUOGL2
;;; 37 HOLDS ≠Q DURING A USER TYPEOUT INSTRUCTION
.SEE PSYM1
FORTY: 0 ;.40ADDR USER VARIABLE POINTS HERE
JSR UUOGLEEP ;SYSTEMIC UUO HANDLER
-LINTVEC,,INTVEC ;SYSTEMIC INTERRUPT HANDLER
;;; THAT'S SYSTEMIC, NOT NECESSARILY SYSTEMATIC!!!
;;; ITS PASSES THE BUCK TO THE USER ON UUO'S 0 AND 50-77.
;;; THEY TRAP THROUGH THE .40ADDR, NOT NECESSARILY 40;
;;; SINCE LISP TREATS THESE AS ERRORS, WE CAN AFFORD TO SAVE
;;; THE JPC AND OTHER GOODIES HERE.
UUOGLEEP: 0
.SUSET [.RJPC,,JPCSAV]
JRST UUOGL1
] ;END OF IFN ITS
JPCSAV: 0
SUBTTL SFX HACKERY
;;; SFX MACRO TELLS WHERE A LONG PIECE OF SEMI-CRITICAL (MAY BE QUIT
;;; OUT OF, BUT MUST NOT PERMIT USER INTERRUPTS IN) CODE MAY BE MUNGED
;;; IF INTERRUPTED IN THE MIDDLE SO THAT WHEN DONE IT WILL RETURN TO
;;; THE INTERRUPT HANDLER. SUCH CODE INCLUDES ARRAY SUBSCRIPT
;;; COIPUTATIONS (SINCE AN INTERRUPT COULD DISPLACE THE ARRAY)
;;; AND ALL CODE WHICH MODIFIES THE SPECIAL PDL.
NSFC==0 ;COUNTER FOR MACRO SFX
.XCREF NSFC
IFE PAGING,[
DAFINE SFX A/
SFSTO \.-FIRSTLMC,\NSFC,[A]
NSFC=≥NSFC+1
A
TERMIN
DEFINE SFSTO PT,NM,IN
DEFINE ZZM!NM
FIRSTLOC+PT
TERMIN
DEFINE ZZN!NM
IN
TERMIN
TERMIN
] ;END OF IFN PAGING
IFN PAGING,[
DEFINA SFX A/
SFSTO \.,\NSFC,[A]
NSFC==NSFC+1
A
TERMIN
DEFINE SFSTO PT,NM,IN
DEFINE ZZM!NM
PT
TERMIN
DEFINE ZZN!NM
IN
TERMIN
TERMIN
] ;END OF IFN PAGING
;;; THE ZZMAND ZZN MACROS ARE EXPANDED AT SFXTBL (Q,V.)
;;; **** ALL USES OF THA SFX MACRO MUST APPEAR ON THIS PAGE ****
SFXPRO
10$ UNBD2A:
10$ POP FXP,R ;Restore R
UNBND2: MOVE TT,(SP)
↓MOVEM TT,SPSV ;ABOUT LOADING TT UITH SPSV, SEE UNBIND
α MOVE TT,UNBND3
SFX POPJ P,
ABIND3: PUSH SP,SPSV
SFX POPJ P,
SETXIT: SUB SP,R70+1
SFX JRST (T)
SPECX: PUSH SP,SPSV
SFX JRST (T)
AYNVSFX: ;XCT'ED BY AYNVER
SFX %WTA (D)
1DIMS: JSP T,AYNV1 91-DIM S-EXP ARRAYS COME HERE
ARYGET: ROP R,-1 ;COMMOL S-EXP ARRAY ACCESS ROUTINE
ADDI TT,(R)
ARYGT4: JUMPL R,ARYGT8
HLRZ A,(TT)
SFX POPJ P,
ARYGT8: HRRZ A,(TT)
SFX POPJ P,
1DIMF: JSP T,AYNV1 91-DIM FULLWORD ARRAYS COME HERE
ANYGET: ADDI TT,(R) 9COMMON FULLWORD ARRAY ACCESS ROUTINE
MOVE TT,(TT)
SFX POPJ P,
IFN DBFLAG+CXFLAG,[
1DIMD: JSP T,AYNV1 ;1-DIM DOUBLEWKRD ARRAYS COME HERE
ADYGET: LSH R,1 ;COMMON DOUBLEWKRD ARRAY ACCESS ROUTINE
ADDI TT,(R)
KA MOVE D,1(TT)
KA MOVE TT,(TT)
KIKL DMOVE TT,(TT)
SFX POPJ P,
] ;END OF IFN DBFLAG+CXFLAG
IFN DXFLAG,[
1DIMZ: JSP T,AYNV1 ;1-DIM FOUR-WORD ARRAYS COME HERE
AZYGET: LSH R,2 ;COMMOL FOUR-WORD ARRAY ACCESS ROUTINE
ADDI TT,(R)
KA MOVE R,(TT)
KA MOVE F,1(TT)
KA MOVE D,3(DT)
KA MOVE TT,2(TT)
KIKL DMOVE R,(TT)
KIKL DMOVE TT,2(TT)
SFX POPJ P,
] ;END OF IFN DXFLAG
NOPRO
SPSV: 0 ;IMPORTANT TO SPECPDL BINDINGS
.SEE $IWAIT
;;; **** THERE MUST BE NO MORE USES OF THE MACRO SFX BEYOND HERE ****
EXPUNGE SFX SFSTO
SUBTTL INTERRUPT FLAGS AND VARIABLES
;;; INTFLG INDICATES WHETHER IN INTERRUPT IS PENDING:
;;; 0 => NO INTERRUPT
;;; -1 => USER INTERRUPT PENDING (STACKED IN INTAR)
;;; -2 => ↑X QUIT PENDING, DON'T RESET TTY
;9; -∪ => ↑G QUIT PENDING, DGN'T RESET TTY
;;9 -6 => ↑X QUIT PENDING, DO RESET TTY
;9; -↔ => ↑G QUIT PENDING, DO RESETTTY
INTFLG: 0
α
;;; MAY NOT ↑G/↑X QUIT OR ALLOW USER INTERRUPTS IF NOQUIT NON-ZERO
;;9 NON-ZEBO IN LH MEANS GC IN PROGRESS; IMPLIES
;;; PDL POINTERS AND NIL MAY BE CLOBBERED
;;; NON-ZERO ONLY IN RH MEANS PDL POINTERS AND NIL ARE OK
NOQUIT: 0
;;; MAY NOT ALLOW "REAL TIME" INTERRUPTS (CLOCK AND TTY) WHEN
;;; UNREAL IS NON-ZERO. MUNGED BY THE FUNCTION NOINTERRUPT.
;;; 0 => ALL INTERRUPTS OKAY
;;; -1 => NO ANTERRUPTS OKAY
;;; 'TTY => ALARMCLOCK OKAY, TTY NOT OKAY
UNREAL: 0
REALLY: 0 ;IF NON-ZERO, THE ADDRESS OF A PDL SLOT FOR THE
;UNBINDER TO UNBIND A SAVED UNREAL INTO.
;SO THAT UNWPR1 CAN KEEP UNREAL SET WHILE BINDING IT.
.SEE WIOUNB
.SEE UNWPR1
ERRSVD: 0 .SEE ERRBAD
;;; INTERRUPT MASK IS ALWAYS INITIALIZED FROM THIS WORD.
;;; FOR ITS, THIS IS THE .MASK (AND .MSK2) WORDS.
;;; FOR TOPS10 AND CMU, THIS IS THE APRENB WORD.
;;; FOR D20, THIS IS THE CHANNEL ENABLE WORD
;;; DEPOSITING DBGMSK INTO IT BEFORE STARTUP CAN AID DEBUGGING.
;;; FOR ITS AND D20, IMPURE LISPS WILL HAVE DEBUG MASKS IN THESE
;;; LOCATIONS; THE PURIFY ROUTINE INSTALLS THE STANDARD MASKS.
.SEE PURIFY
.SEE DBGMSK
IFN D10\D20, OIMASK: 0 ;HOLDS OLD INT MASK WHEN INTS ARE DISABLED
10% INTMSK:
IMASK: STDMSK ;INTERRUPT MASK WORD
IT$ IMASK2: STDMS2 ;ITS HAS TWO INTERRUPT MASKS
LFAKP==5 ;MUST BE LONG ENOUGH FOR USES BY
LFAKFXP==6 ; PDLOV, ERINIT, AND PURIFY
FAKP: BLOCK LFAKP ;FAKE REGPDL, FOR USE BY PDLOV AND ERINIT
FAKFXP: BLOCK LFAKFXP ;FAKE FIXPDL, FOR USE BY PDLOV AND ERINIT
IT$ VALFIX: 0 ;-1 --> VALRET 'STRING' IS REALLY A FIXNUM
IT$ .SEE VALSTR
IFN D10,[
CMUP: 0 ;CMU MONITOR?
IFE SAIL,[
MONL6P: 0 ;6-LEVEL MONITOR OR BETTERP?
] ;END OF IFE SAIL
] ;END OF IFN D10
;;; IF NON-ZERO, THIS CONTAINS THE ADDRESS OF A USER-SUPPLIED
;;; INTERRUPT PROCESSOR. THE DISP SYSTEM INTERRUPT HANDLER
;;; WILL GIVE IT ANY INTERRUPT LISP DOESN'T PROCESS ITSELF. SEE INT0.
UPIINT: 0
IFN D20,[
;;; TOPS-20 INTERRUPT VARIABLES
;;; FLAGS SETUP BY ALLOC AND SUSPEND
αCCOCW1: CCOC1 ;This words may be "remodeled" at allocation time, and at
CCOCW2: CCKC2 9 start-up from suspensiOn, to account For 10X/20X differences
TENEHP: 0 ;Also set up as above
VTS20P: 0 ;Non-0 if systemhas the Virtual Terminal Support
;;; BLOCK OF THREE LOCATIOFS IN GHICH THA PC IS STORED ON AN INTERRUPT.
;;; ONE DOCATION FOR EACH MF TOPS-20'S THREE LEP
→L~∃∪≥Q!εbt$`~∃∪9)!εdh∩`~∃%≥)!εLt∩`~(~∀vvlA) ≠A∨%β%dA→∨π¬)∪∨≥LA+' ⊂A¬2A%≥) %I+!(A!β≥ →∃%&~∃A →'-Pt∩`∩m+' λ↓↓2@IA →∨,↓)≡A'¬-
Aβ A(A/!∪→
A5+≥∂∪9∞A)⊃∀A∪≥)A _~∃M+!'βXt@`∩$∩w+'∃λA¬2↓∪⊂~R≥*@4*e1JNZ#P%@$HIn2⊗4*1↓I¬αεJεl*R⊗J≠QαNε4)αP4TbYJN41h%@HH%l$J↓↓↓↓¬~εZ∃∧04*23∩NQIPI@$$KX$%↓α↓↓αN,~>*⊃¬~εZ∃¬ 4*23~NZQPI@$$KZ2⊗Z,a↓Mα∧
Jε6-"⊗JMRαNεZ*αP4*e1NNZ3P%@$HId$%α↓↓↓α≤
Z∃α0h*2Y≥~QIhK$$%XH%↓↓α↓αN⊗≤z:↓α≤
Z∃α h*∩Nm~εYhJp$$%]α>&:$*Iα&u"=αNl
21α≥"ε∞-¬*N⊗⊃∧∩eα∩≤j&:PhP&
2|~-↓EH%nRzα
∃α≤
~∃1∧∩VQ↓"αN">,b⊃α
*α6εbLjV5α$*BR hR&Q∃∧~9:jCP%@$HIn↑"-∩∃αRzα⊗b&"αε~R-⊃αzhhP4)m[YαεM¬"ReαLrR⊗J∃*BQα≤Bε::,aα6V≥!α
∃∧"f:εlJ∞ε2eIαε2dz∞εR,!1αεt!αR"-∩∃αε∀(4)m[Yα~⊗<*Iα∞D
::⊗e→αR" qαR"*αR>R aαB>≥~&
2*α:V6∀*Iα>2α&*R-∩JVB"α∞"ε∀
∞B⊗∃→04)[Yeᬬ"ε
2*α&Mα-~⊗⊃α$yαNR⎇∩∃αRD)α&:4zJ6ε$J699ααR"∃¬"ε
2*α&M↓ A9α↑⎇∩∩Mαdz:
8hQemm∧ αj⊗∀yα⊗:%∩eα&~αV:V≤*⊃1αtz2j⊗∀yα"ε~α&*R-∩JVB"α∞"ε∀
∞R⊗∩q↓α&2αR"∃¬"ε
2(h)mmZα⊗*R∃Iα&M∧r⊗≡ε$JR∃1¬""⊗9¬""∃α≤Bε::,aα&M∧
NN&<r⊗⊃α4zIαN|j∃α>$B⊗Iα-~∃84Ph)n∞D
::⊗bαεNNL::6⊗u"Mα~⎇⊃α:>rjNRεt"εJ⊃Cy%α&u"⊗JJ-αRL4Ph*∞&u"ε hhRR&∞l
A↓:$J
ε∞|"∀4*∀*B⊗ε"↓Ea9ka96∞LrRε ra↓@$HIf&:M"&ε2eIαV:-~⊗⊂4T~&*R≥Quu9l~&:R ⊂4*tHIn⊗:"α&~9∧!I@$hP4(0$λhRNF
%"1↓α$*~&:M"&>j4∧|2
JEJ¬8¬⊂*J4h∃izQ∀c!! R1Id∩5∀eKc"Ng]P$g∩j AL TTY STATUS IS AS FOLLOWS:
α;;9 ACTIP
β)%≠∀Aπ!β%&T4∀vvv$∪=[y_XA≥8[=$X↓=8K=|XA'↓¬π
X@p@|@PR@Av↓xA%+ ∨#(@↓β$~∀lvv∩∪1¬%βπ- @AI¬%βπ- (~∀lrv∪∪9) %%U!(Aπ!β%&T4∀vvv$∪=[y⊂XA≥,XA=_0A=≤[y0XA=p[=>X↓'!βπ∀~∀fVl∩∪=⊂↓β≥λAM!βπ
↓ ≡A≥=(A∪≥Q %%+A(∩∀vlp &N∧
∞∃α r⊃α
~.NB ~∃α>-"BVQ∧J1α&l
≡∃αlz∩¬1∧
21α⎇""-*4∧L@H⊂4h92+C!'nnb(→⊃λ⊂iλ4ThλXp∪h →β⊂($H&gb"H∀"ad∪P+d"S⊂*,h⊃b⊂V⊂⊃l!bh∃⊂)*a∪jj⊂"∪big∪U⊂"ad∪WαE≥N]FE≥N]P!"PβALL THAT THE TUELVE CHARACTER GROUPS ARE:~∀lp
l&t↓αj¬mr→αzZjz1αtq6zI¬rQ6ZRαzJ
∀
∞.⊗ αzaαuqαz\hQmmlL 6i↓E*BB⊗⊂∧∧84q*%D_+>D¬⊃∪uhZH⊂p*8*#"G]]DX \BE≥N]DP@λα # $ ! & ' $ . : ;}AApA@Ax↓x⊂∀)[Yd%)αY↓5↓z↓uαy¬x4)MYX%q↓p↓!↓¬∧π2πr H%∀ 98U"¬(*$ ≤8Z@hS4εfa≠Qh↔J1"Nng⊃4π%⊂↔$BE≥N]D`f∃&gb"CE≥P≠; ↑M
8εvv∪I+¬∨+P~∀f@[X&NB ~∃αz@h):N,)↓⊗R8h(&N%"f]Eki`∪∪6"β∪αEF#β∪ε& HK8:D
¬Z4¬<@tQ∀dλStH itS0)D∪3qλQ"B4jJ⊗5lGW.LLf&LL ¬FLL F6A"B*:∃⊗3ε↔/.LF6L D¬E L FεLα"'~u⊂5
Zh∃sj(∀h⊃IZH∪∩)hαP&gQ"@
SP )30dzjtHbd`d@XXdd@ddd~(∪'))eαbzzh`dddHdXXdHdddd$∩w'$
RVM¬:>J∩~α~>I∧
22≡_h(&N%"f¬IiiaMIβ⊃II1c↓IAI∪⊂4*@Q⊃∪\,hD∧|2 _dr∧~J0hPQ)∀4rλF#αe1Q#K[4λ6}wN-vbl= ↔⊗∞>LW∩l}↑Gπ/EX6}wN-vbαT
G>z -↔'~ iw∩ε\≤6Bε=⎇g'⊗⎇Dε≡F≡,⊗∨&↑!PS[74αβα¬TεN>m}&*b↓Q#[[4∧β
αT∞π⊗NnD¬uBD∧hS772αβ$¬Rε␈↑Nπ/"∞]fn}M≤fN.EDαh'73Jαε4αjπ=→W.f≡LRε6}-V∂" ≤7&N⎇aPU∀_I∃BβAQ L≤9x3 kW&∪ ⊗⊗∪ ∪66# 6⊗∪ λQ$αL89t≠∪WW# ⊗⊗∪ ⊗⊗3 ⊗⊗βββ↓Q%∀ I≠αβ@Q'2¬≤XT∧≤≤x:s
∧→hB∧≤9x5;λQ!PS[74∧6␈↑$ε≡f≡:6/~
|bπ>≥<Ro/∧ 6}wN-v`h+λ∀≥%wWSU%DZt\2:JB-<9e5%"Zy5α]JDU<\⊃↔45,ID¬< 8T¬-¬1Q%D :ICkk*JB-<8a⊂HH↔:t \T
U¬~λiu∩α)I∀t,YxD*⊂Q*5$$)Zskmλ_5%::JB,,9u3buJH∃≤≥vg`Ju8XR¬%DXD hQ!PPH⊃↔5≥$→hD
∀D $4r Yt$*
yu∀"λiu∩¬HZ$lLh→@hU:HE$mwWU$jXJ¬HH↔:5$ hH∃∀"
HU∀l→h∀b∧YxD*¬yz$"bλiu∩¬jJ2¬≥JXd0h*:D%$~wSk⊃↔5≥$→hD
∀D
D-∀Y→d b →e$-**U¬"
yu∀"¬Tεv␈D∞&.∞MO∩π/<\Bλh*I∀≤l~∧π]≥HJDM;WZ5$%I~r[c≠wC≠*UjDL~_9t$+go`hUQ⊃∪\,hD∧|2 _dr∧F&hPQ)∀4r
8∀LbK1PU≤_:E; WS#;;vvs;;vv3;Q*4 ≥Jv#kk&ε3ββεεββ+εεhU8_5%;7WSSβεεβββ&Fβββ↓Q%≤ :Js#kW&βββεεS∪βεεβh!Q%≤ :IC kW&s;+⊗vs+;v6sh*8∀≥$F'SkSεεβββεεβββε↓PU≤_:Dc≠WW#ββεεβββεεββQ*4 ≥IFCkk&εβββεε#ββεεhUQ⊃∪\,hD∧|2 _dr¬8→∀`h!Q hPQ*5,∃JI@L,jJ$L-4
Dz¬h~$L]Z4¬∀⎇ZI∀t-4λ4 dHXB∧∃∀ %≥⊂Q!PU,~:D [!⊗HK8:D ≤4
Uααλ_5%,→IEJb
~T-,U∀∧
¬X8U∩∧→jE$-**U¬ Q!∀U∃:D¬,M:I3λh!Q$<≥*:#PK↓⊃∪\<4
$-≥Iz$*Rλ9D, j4¬-α *U≥"λ(T4⎇(T∧ pQ!∀U∃:D∧<≥*:#K4λ∀∀tz)T bλ[∧Mα¬λt≤,hD∧M~ iu∀l→D∧-D~E∩ph!Q$L4d
∧ <→hreXQ*∧$e:IβPK↓⊃∪J∃λIB¬≥D ∧ ≤4%b∧<ZJ2∧
hU:¬λ_t*∧iz"∧
λDb`Q!∀U∃:D¬∧$J:CK4λ∀t"
Z∧$
HZ2¬≥Dλ∀t"λx5≥"λ~¬¬∀z
$L
HYEJpQ!PTLid∧#∪¬K0hUλIE≥$↔!∪H↔:D,m
4∧4⎇$
4
4→hr∧ :1PU∧IJ5$∪!⊗hUλIE≥$7!∪h+Q⊂K\YhB∧|d ∀4rλF#h+Q⊂K\YhB∧|d ∀4r
λ∀<LhqPPh `h!Q%≥,*JD`LhZtLz ∃tz∧9λ∀ttYD∧ dIx4
$→yb¬$_)D(h!Q#[[4λTu%)_U≠PQ'3[X⊗EcJβWd∧≤D→id,b ~2∧dx94,"λiu∩∧∀
∧
∃I_5,d~$¬¬-* u≤(Q'3[X⊗∃c
k%g∩βkdλ∀$%(Z5~∧xd∧4LHT∧
∃(≠∩¬≤~!PS[74∧L2λ→b∧,E ARRAY SAR'S
;;; TTS.CL BIT IS SET, THE CHANNEL MAY BE DE-ALLOCATED.
;;; THIS ORDINARILY HAPPENS ONLY ON A QUIT OUT OF $OPEN.
;;; CHANNEL 0 (TMPC) IS PERMANENTLY LOCKED FOR USE OF THE ERR
;;; DEVICE, FOR UPROBE, ETC. NOTE THAT ITS PUTS .OPEN
;;; AND .CALL FAILURE CODES ON CHANNEL 0 ARBITRARILY.
IFN ITS+D10, LCHNTB==:20 ;NUMBER FIXED BY OPERATING SYSTEM
IFN D20, MAYBE LCHNTB==:40 ;THIS NUMBER IS BASICALLY ARBITRARY
CHNTB:
OFFSET -.
TMPC:: 400000,,NIL ;FIXED TEMPORARY CHANNEL
IFGE LCHNTB-., BLOCK LCHNTB-.
.ELSE WARN [TOO MANY FIXED I/O CHANNELS]
OFFSET 0
;;; DEC-10 I/O BUFFER HEADERS (MUST REMAIN FIXED IN CORE)
;;; THEY ARE NAMED BFHD0, BFHD1, ..., BFHD17.
IFN D10, REPEAT LCHNTB, CONC BFHD,\.RPCNT,: BLOCK 3
DPAGEL: 60. ;INITIAL DEFAULT PAGEL
DLINEL: 70. ;INITIAL DEFAULT LINEL
IFN JOBQIO,[
LJOBTB==10 ;EIGHT INFERIOR PROCEDURES
JOBTB: BLOCK LJOBTB
] ;END OF IFN JOBQIO
SUBTTL INITIAL TTY INPUT FILE ARRAY
-F.GC,,TTYIF2 ;GC AOBJN POINTER
TTYIF1: JSP TT,1DIMS
TTYIFA ;POINTER BACK TO SAR
0 ;ILLEGAL FOR USER TO ACCESS - DIMENSION IS ZERO
TTYIF2:
OFFSET -.
FI.EOF:: NIL ;EOF FUNCTION (??)
FI.BBC:: 0,,NIL ;BUFFERED BACK CHARS
FI.BBF:: NIL ;BUFFERED BACK FORMS
TI.BFN:: QTTYBUF ;PRE-SCAN FUNCTION
FT.CNS:: TTYOFA ;ASSOCIATED TTY OUTPUT FILE
REPEAT 3, 0 ;UNUSED SLOTS
F.MODE:: SA% FBT.CM,,2 ;MODE (ASCII TTY IN SINGLE)
SA$ FBT.CM\FBT.LN,,2
F.CHAN:: -1 ;CHANNEL # (INITIALLY ILLEGAL)
20$ F.JFN:: .PRIIN ;JFN (FOR D20 ONLY)
20% 0
F.FLEN:: -1 ;WE EXPECT RANDOM ACCESS TO BE ILLEGAL
F.FPOS:: 0 ;FILE POSITION
REPEAT 3, 0 ;UNUSED SLOTS
IFN ITS+D10,[
F.DEV:: SIXBIT \TTY\ ;DEVICE
IT$ F.SNM:: 0 ;SNAME (FILLED IN)
10$ F.PPN:: 0 ;PPN (FILLED IN
F.FN1::
IT$ SIXBIT \.LISP.\ ;FILE NAME 1
10$ SIXBIT \LISP\
F.FN2::
IT$ SIXBIT \INPUT\ ;FILE NAME 2
10$ SIXBIT \IN\
F.RDEV:: BLOCK 4 ;TRUE FILE NAMES
] ;END OF IFN ITS+D10
IFN D20,[
F.DEV:: ASCII \TTY\
] ;END OF IFN D20
LOC TTYIF2+LOPOFA
NTI.WDS==6↓ ;HOW MANY OF THASE TTY-INPUT WDS?
IFN IPS+D20+SAIL,[
TI.ST1::
IT$ STTYW1 ;TTY STATUS WORDS
20$ CCKC1 ;"REMODELED" AT TXNSET time
SA$ SACTW1
TI.ST2::
IT$ STTYW2
20$ CCOC2 9"REMODELED" AT TXNSET time
SA$ SACDW2
TI.ST3::
IT$ 0 ;TTY ACTIVATION-CHARACTER WORDS
20$ STDJMW ; (EXCEPT ON ITS -- USUSED THERE)
SA$ SACTW3 ; TWENEX JFN-MODE WORD FOR TTY
TI.ST4::
IT$ 0
20$ STDTIW
SA$ SACTW4
TI.ST5:: 0 ;TTYOPT WORD (STORED IN ITS FORMAT,
; ALTHOUGH READ FROM D20 BY RTCHR
TI.ST6::
20$ STDTMW ;TERMINAL MODE WORD (D20 ONLY)
20% 0
TBLCHK TI.ST1,NTI.WDS
] ;END OF IFN ITS+D20+SAIL
.ELSE BLOCK NTI.WDS
LOC TTYIF2+FB.BUF
FB.BUF:: ;INTERRUPT FUNCTIONS
IFE SAIL,[
NIL,,IN0+↑A ;↑@ ↑A "SIGNAL" ON
IT% QCN.BB,,NIL ;↑B ↑B-BREAK ↑C
IT$ QCN.BB,,IN0+↑C ;↑B ↑B-BREAK ↑C GC STAT OFF
IN0+↑D,,NIL ;↑D GC STAT ON ↑E
LIL,,IN0+↑G ;↑F ↑G HARD QUIT
REPEAT 3, NIL,,NIL ;↑H-↑M (FORMAT EFFECTORS)
NIL,,NIL ;↑N ↑O
NIL,,NIL ;↑P ↑Q
IFE D20,[
IT$ IN0+↑R,,IN0+↑W ;↑R UWRITE ON? ↑S ↑W INT, ↑V MACRO
IT% IN0+↑R,,NIL ;↑R UWRITE ON? ↑S
IN0+↑T,,NIL ;↑T UWRITE OFF? ↑U
] ;END OF IFE D20
IFN D20,[
NIL,,NIL ;↑R ↑S
LIL,,NIL ;↑T ↑E
] ;END OF IFE D20
IN0+↑V,,IN0+↑W ;↑V TTY ON ↑W TTY OFF
IN0+↑X,,NIL ;↑X SOFT QUIT ↑Y
IN0+↑Z,,NIL ;↑Z GO TO DDT ≠ <ALTMODE>
NIL,,NIL ;↑\ CKNTROL RIGHT-BRACKET
LIL,,NIL ;↑↑ ↑←
REPEAT <NASCII/2>-<.
FB.BUF>, NIL,,NIL ;ALL OTHARS INITIALLY UNUSED
] ;END IFE SAIL
IFN SAIL,[
REPEAT 100, NIL,,NIL ;ALPHABETIC (ASCII 0 THROUGH ASCII 177)
REPEAT 40, NIL,,NIL ;LOW CONTROL ↑<NULL> UP TO ↑@ (200-277)
NIL,,IN0+↑A ; ↑A
QCN.BB,,IN0+↑C ;↑B ↑C
IN0+↑D,,NIL ;↑D
NIL,,IN0+↑G ;↑F ↑G
REPEAT 3, NIL,,LIL
NIL,,NIL ;↑N ↑O
NIL,,NIL ;↑P ↑Q
IN0+↑R,,IN0+↑W ;↑R ↑S
IN0+↑T,,NIL ;↑T
IN0+↑V,,IN0+↑W ;↑V ↑W
↓ IN0+↑X,,NIL ;↑X ↑Y
IN0+↑Z,,NIL ;↑Z
REPEAT 3, NIL,,NIL
QCN.BB,,NIL
NIL,,NIL
NIL,,IN0+↑G ;LOWERCASE ↑G
REPEAT 11, NIL,,NIL
IN0+↑Z,,NIL
REPEAT <NASCII/2>-<.-FB.BUF>, NIL,,NIL
] ;END IFN SAIL
OFFSET 0
SUBTTL INITIAL TTY OUTPUT FILE ARRAY
-F.GC,,TTYOF2 ;GC AOBJN POINTER
TTYOF1: JSP TT,1DIMS
TTYOFA ;POINTER BACK TO SAR
0 ;USER MAY NOT ACCESS, SO SAY DIMENSION IS ZERO
TTYOF2:
OFFSET -.
FO.EOP:: QTTYMOR ;END OF PAGE FUNCTION
REPEAT 3, 0
FT.CNS:: TTYIFA ;STATUS TTYCONS
REPEAT 3, 0
F.MODE:: FBT.CM,,3 ;MODE (ASCII TTY OUT SINGLE)
F.CHAN:: -1 ;CHANNEL # (INITIALLY ILLEGAL)
20$ F.JFN:: .PRIOU ;JFN
20% 0
F.FLEN:: -1 ;NOT RANDOMLY ACCESSIBLE
F.FPOS:: 0 ;FILE POSITION
REPEAT 3, 0
IFN ITS+D10,[
F.DEV:: SIXBIT \TTY\ ;DEVICE
IT$ F.SNM:: 0 ;SNAME (FILLED IN)
10$ F.PPN:: 0 ;PPN (FILLED IN)
F.FN1::
IT$ SIXBIT \.LISP.\ ;FILE NAME 1
10$ SIXBIT \LISP\
F.FN2::
IT$ SIXBIT \OUTPUT\ ;FILE NAME 2
10$ SIXBIT \OUT\
F.RDEV:: BLOCK 4 ;TRUE FILE NAMES
] ;END OF IFN ITS+D10
IFN D20,[
F.DEV:: ASCII \TTY\
] ;END OF IFN D20
LOC TTYOF2+LOPOFA
BLOCK 6
ATO.LC:: 0 ;LINEFEED/SLASH FLAG
AT.CHS:: 0 ;CHARPOS
AT.LNN:: 0 ;LINENUM
AT.PGN:: 0 ;PAGENUM
FO.LNL:: 71. ;LINEL
FO.PGL:: 200000,, ;PAGEL
FO.RPL:: 24. ;"REAL" PAGEL
OFFSET 0
BLOCK <LOPOFA+LONBFA>-<.
TTYOF2>
SUBTTL SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT
;;; DONT ALLOW USER INTERRUPTS WHILE:
;;; (1) NOQUIT IS NON-ZERO - THIS PROTECTS GC,
;;; RETSP, SUBLIS, AND OTHERS.
3;; (2) INHIBIT IS NON-ZERO - THIS PROTECTS
;;; MANY AREAS OF SEMI-CRITICAL CODE.¬
;;; (CF. LOCKI AND UNLOCKI MACROS)
;;; (3) UNREAL IS NON-ZERO (DEPENDS ON EXACT VALUE)
;;; - THIS IS FOR THE NOINTERRUPT FUNCTION
SWS::
;;; THE FOLLOWING STUFF IS SAVED WHEN AN "ERRSET FRAME" IS CREATED.
;;; NOT ONLY ERRSET, BUT ALSO CATCH AND READ NEED TO DO THIS.
;;; INTERPRETED PROGS CREATE A SORT OF HALF-ASSED FRAME.
;;; BEWARE! THE COMPILER DEPENDS ON KNOWING THE LENGTH OF
;;; THE ERRSET FRAME AS A CONSTANT PARAMETER.
ERRTN: 0 ;PDL RESTORATION FOR ERRSET
CATRTN: 0 ;PDL RESTORATION FOR CATCH OF A THROW
EOFRTN: 0 ;PDL RESTORATION ON E-O-F TRAPOUT
PA4: 0 ;PDL RESTORATION ON GO OR RETURN
INHIBIT: 0 ;NON-ZERO => INHIBIT (DELAY) ALL USER INTERRUPTS
; -1,,0 => INHIBIT ALL EXCEPT TTY INTERRUPTS
ERRSW: -1 ;0 MEANS NO PRINT ON ERROR DURING ERRSET
; ACTUALLY, "UNREAL" IS STORED IN THE LH OF THIS WORD
; WHEN AND "ERRSET-PUSHED" BLOCK IS PUSHED.
BFPRDP: 0 ;LH: FUNCTION WHICH WANTS TTY PRE-SCAN
; (READ, READLINE)
; TYI FOR ACTIVATION AND CURSORPOS
; CLEVERNESS, BUT NO PRE-SCAN
; NIL FOR NO CLEVERNESS AT ALL
;RH: -1 IF WITHIN READ
CATID: NIL ;RH: CATCH IDENTIFICATION TAG
;LH: FLAGS INDICATING SUBTYPE OF FRAME
CATSPC==400000 ; SPECIAL PROCESSING NEED BE DONE (OTHER BITS HAVE
; MEANING)
CATLIS==200000 ; C(RH) IS POINTER TO A LISTOF CATCH TAGS
CATUWP==100000 ; UNWIND-PROTECT, C(RH) IS FUNCTION
CATAAB==040000 ; CATCH-BARRIER: RHPOINTER TO (CONS FUN CATCH-TAGS)
AATALL==020000 9 CATCH-ALL: RH IS FUNCTION OF TWO ARGS
CATCOM==010000 9 FROM COMPILED CODE, DO CALLF, NOT IPROGN
¬
LEP1==.-ERRTN ;***** LENGTH OF SOME OF ERRSET PUSH
KMPLOSES==-<.-ERRSW)1>
.SEE ERSTP
UIRTN: 0 ;FON-ZEBO =6 PDL LOC GF MOSTRECENT USER INT FRAME
,SEE UINT0
~∃I'1)∧h∩QαR$∩w!∨%≥) $↓)≡A%∃βλA'e≥)β0↓)β¬→∀XA∪≥⊃ 1 λ↓↓2Aα4∀~∃!9≠⊗bt$`∩∩]M
A!⊃→≥≠⊗$w'β-∀A)(~(~∃∂π⊂]αt∩$∩]' ∀A∂π ∧∩∃+9¬≥λfh∩∩∩]M
A+9¬∪≥λ$w'β-∀A)(~)'∪1≠,dt∩`$∩]' ∀A'∪15β⊗~∀4∃'β-5β$t∩$∩]' ∀A'+'@bh∩w9 ≤≥(A¬
↓∪≤A']&XA¬U(A/⊃<Aπβ%∃&}~∃≥πλ]∧h∩∩∩]M
A∂
¬∧~)β+≥¬⊂t∩∩∩9'
A¬+≥¬∪9λ∩w'¬- &A⊂A
∨$↓β+≥¬%≥λ~∃∃1 ]&h∩∩∩]M
A a ∩w%∃≠ ≠¬∃%&A'%∂≤A∨_Aβ%∞4∃β)β8]&t∩$∩]' ∀Aβ)β8∩w'βY &A'%∂≥&A= Aβ%≥&@y00Y2|~)+≥≠)5 t∩∩$w+≥β5
A) 5 ~∃
A) ~t$∩∩w!M3~A/¬≥)&AQ⊃∪&AQ≡A¬
↓'β≠
↓β&A!
≥(BB∧~∃∪
1(rt∩$∩]' ∀A∪
→=β(∩w⊂A'β-∃λA⊃ I
~∃ E→ t∩@∩∩w!⊃_A!∨%≥) $↓+!∨≤↓ ≥)%dA)≡A∃#+β_4∀∩∩∩9'
A∃#+β_4∀~∃∂
λ]εt$∩∩]'∃
A∂π⊃¬∧~∃¬)β≤]`t∩∩∩9'
A¬)β≤∩m) ≠!=%β%2↓0A-β1+
~∃≥/ π≥Pt∩`~(~∃∂π⊂]λt∩$∩]' ∀A∂π ∧~∃βQβ≤]2h∩∩∩]M
AβQβ≤∩wQ ≠!∨Iβ%2AdA-β→U
~∃∂] ∨%∞h∩`∩w=%∪∂∪8A∨ A1β!!∪→∪πβ)%∨≤@Z↓∂/ %≤bA∪&↓∂/ ∨I∞Zb~(~∃∂/⊃%∞bt$`~∀_~∃ a!_jt$`∩∩wQ ≠ A→∨$A a!→∨ ∀~∀~∃≥πλ]+ t∩∩∩9'
A≥π ¬∧4∃¬↔)I t∩∩$]'
↓¬β↔)Iβπ
~) ,a∧h∩∩∩]M
A Yβ_~∃→→β(bh∩∩∩]M
A
1β)'∪i
~∃≠∃≠,t∩@∩∩]'∃
A≠ 5¬ $~(~∃+βA∨&t∩$∩vZbt|A+/I∪)
X|z`@t|A+βA! ≥λ]βππ∃'&A!=&~∃∂
λ]-⊂h∩∩∩]M
A∂
¬∧~)→!≥ h∩∩∩v4bA≠ ¬≥&A≥=(AαA1∨≥∞AA≥β≠
Q
∪)LA∪≤AA≥¬+ $~∀∩∩$Y'
↓%∪≥)∃%≤~∃¬+≥¬$h∩`∩∩m'β- LA$A
=$Aβ+9¬∪≥λ4∃ →) t∩`∩$vFA∨_A)∪≠∃&A 1 )
←⊃ →"AM⊃∨+→⊂A% ≠=-
A∪Q ~~∀$∩∩]'∃
A 1"~∀~)%∪≥ h~∃β!→≥∞bt4∃)β¬1*bt∩@~∀~∃¬+≥¬ h∩∩w'¬- &A_A
∨$↓β+≥¬%≥λ~∃%
A¬%∂≥+~16~∃≠9≠0`t$∩vE≠%≤DA∪9')%+
)∪∨≤4∃∂% M&`t∩@∩vE∂I β) I DA∪9')%+
)∪∨≤4∃:∩∩m ≥λA= A∪
∀A¬∪∂9+~~∃%
≤A¬%∂≥+~16~∃∂I '&`h∩`∩v ≠∪≤D↓β≥λE≥% β)∃% DA%≥')%Uπ)∪∨8~∃π
¬∪_t∪)%'(@8∩w)%¬≥'
HA∨≤A→β∪→+I
~∃πM+π
t%∃%'(\∩w)Iβ≥'
∃$A∨≤↓'+ππ∃ λ~∃t∩∩w 9λA∨ ↓∪
≤A ∪∂≥+4~∀~∃%(H∪∪='(t∩9')β)U&@``1α~∃∪→≤A∪)LXA'3Mπ_pt4∃¬βπQ3 t∩@∩w5 I≡A∨≤↓
∪%'PA→∨∨@A)⊃%=+∂⊂A βπ)%¬π
\~)¬∨∨→$t∪' Q5∧Aλ1)(∩w ∨∨→ ¬≤A∪≥M)%+πQ∪∨≤A→∨$A¬=∨→
~(~∃)∨Aβ'(t$Zb∩∩m∪ @ZDA)⊃ 8A)∨ 5→ - 0Aβ')∃%∪'⊗↓≥∨(AA%∪≥)∃λA∪ ↓-∪≥
%→
~∀$∩∩vA%&A∪≥%∪
α~)∪
≤AU' → M&XA!I∪≥→,h∩vyπU%% ≥PA!%∪9(A→ Y _|ZD~∃!→U&`t∩@∩∩w)e!
@Z↓#
∪19+~A∨HA#
→=≥+~~(~∃∪
∀A¬∪∂9+~Y64∃!→+Lft∪β⊃λAλYQ(~∃!1+<%
βλA⊂Y)(∩m
→∨βP[!∨∪9(A∪≥M)%+πQ∪∨≤A→∨$AβI∪)⊂A≥ ≥ %¬)∨$~):∩∩w∃≥λA∨_A∪
↓¬∪∂≥U~~∀~(~∃∪
8A+' 1 '&X↓⬬%M.t∩w-∪≥λA= A')U
A ∃'∪% ⊂A
%∨4A!%∪9(`t~(∩∩∩vZ@z|↓∨≥→2↓⬬%∃,A')U
~∀$∩∩v@@@z|A=≥→2A9∨≤[β ¬% ,↓')+
_~∀∩∩$v@V@t|A¬∨Q⊂@Q %')∪≥≥+∪'⊃∃λA¬2↓)3∨'\R~∃!1+&pt$`∩∩vq≤XY≤xA/⊃ I
A)⊃∃%
AβI
A≤A¬%∂&~)%~ht$`~∃∪→≤A+'∃→ '&0A!%!Iπ(t∩m!%∪≥PO&A!¬% ≥&↓π∨+≥Q&@Q→∃
(XYI∪∂⊃($~∃'/9βπ⊗t$`∩∩wU' λA→∨$A/9αAπ⊃∃π↔∪≥≤A∪≤AM)β)+L~∀∪∃I'(A'Qβ(b~)∪
≤AU' → M&XA)e∨'.t`∩w≥=%≠β→12A5 I≡@ZAQ →→&↓)3≡AQ3!
A= Aπ⊃¬$~∀∩$∩v@Vz|Aπ!β$A∪LA
∨$↓
∪→ LA∨≥→d~∀∩∩$v@Z@t|Aπ⊃¬$A∪&↓
∨$AQ)2A∨9→2~∀$∩∩v@@@z|A
⊃β$A%&A
∨HA¬∨) A
∪→∃&Aβ≥⊂A))24∃% ¬-εt∩`$∩w'βY λA¬I β⊗A
⊃β%β
) $X↓∨≤A a∪(A
I∨~A%⊃π⊃β$4∃% ≥M,t∩`$∩w'βY λA≥U≠¬ $Q¬
=%
A ∃π∪≠β0[∨$[9∨(A∪LA π% λR4∃% M,t∩`$∩w'βY λA-¬→+
A= @FA= A ∪≥∪)&AQ≡A%∪≥⊃(A∨_A π%≠β_AA∨∪≥(4∃% ∪ &t∩`$∩w≥+5 %∪ε↓∪¬β'∀A +%%≥∞A%∃β ∪≥≤~∃∪
8A+' 1 '&X%% %∨5 t∩`$w%∨≠¬≥ @Z↓β%
AI∨≠β≤↓≥+≠ Iβ→&A=⊗}~∃I ∪≥π t∩`∩$w'∨+Iπ
A∨_Aπ⊃βIβπ) I&A
∨HA% β⊂~∃π∨I¬ t∩@∩w¬3Q
[!∨%≥) $↓
∨$AI βλ[M∨+%π∀A/⊃ 8A'∨+Iπ
A∪LA¬→∨
⊗A∨ 4∀∩∩w¬'π∪∩↓∨$A'%1¬∪(↓')+
_A∪≤A
∨%
~)≠↔≥π t∩`∩m∪≥')I+π)∪%∨≤A
=$A≠β-≥β~AQ≡A∂ PA≥ 1PA¬3)∀~∀_~∀vlvA)⊃∀A!≥β5
A¬+→
$A%&A+'∃λA
∨HA-β%%∨+&A¬≥λA'U≥ %2↓!+%!=' &\4∀vvv↓)⊃
AA%∪≠βI2A!+I!∨'
↓∪&Aβ
π+≠+1β)∪≥≤A!%∪9(A≥β5 &A∨_Aβ)∨5&\~∀9'
AI∪≥) I≤~∀vlvA∪(↓∪&Aβ1'≡A+M λA
=$A-β1% (A¬≥λA'U'! ≥⊂A')%%≥∂&X4∀]' ∀A-β→I (~∀9'
AM+'! 9λ~∀vlvA∃π0XA≥β5 ')%%≥∂&A= A
∪1 &@Q∃'! π%β→→2↓
∨$A⊂d`A∂Q∃
≤A)'3&R0~∀]'∃
@m¬Q≥&~∀lvvA I%∨$A5 ''β≥
A')I∪≥∞AA%∨π M'∪≥∞0~∀]'∃
A %I∪∨∀~(vvvA¬≥λA'<A∨≤\A
∨$↓'∨≠
↓!+%!=' &AQ⊃∪&A +
HA∨- I→β!&↓)⊃
A ∪∂≥+4A) ≠A&\~∀H`J∪≠¬3¬
A1!≥¬+_zztb@~∀d`⊂∪≠β3
A→!9¬+ zttj`~(~∃!≥ t∩hP`n``0Y!≥¬U ∩w¬e)
A!=∪≥) HA
∨$↓!≥β≠∀A¬+
→ $~∀4∃!≥¬U t∪¬1∨π⊗A1!≥¬+_~∀∩`$∩w 1Q%αA/=%λA+M λA)<A∂+βIβ≥) ∀A)⊃βPAαA'Q%∪≥∞↓πβ≤A
A≠β⊃
Aβ'
∪4~∃)π→¬ tzu!≥ + Vb$w'∪≥
A')¬)+&A)π_A≠¬2Aπβ1_A∪≥Q %≤A=≤AαAMπ≡~∃¬)≠¬ tzu!≥ + Vb$w ∪)Q≡A∪≥Q %βπQ∪∨≤A )/ ∃≤A!%%≥)αA¬≥λA a!→∨ ∀~∀~∃%
≤A¬%∂≥+~16~∃%∃≠
_t$`∩w%∃≠β∪≥⊃ $A
1β∞~∃Y )¬_@t∩`∩m ∪-∪M∪∨≤AM)+
4∃ -&Dt∩`~) -&d 0
DVSD: 0
αDD1: 0
@D2: 0
DD3: 0
DDL: 0
NORMF8 0
QHAT: 0
BNMSV: 0
FACF: 0
FACD: 0
AGDBT: 0
αYAGDBT: 0
TSAVE: 0
DSAVE: 0
RSAVE: 0
FSAVE: 0
NRD10FL: 0 9NOT READIN@∞A∪8A¬β'∀@b`\↓
→β∞4∃:∩∩m ≥λA= A∪
8A¬∪∂9+~~∃%
∞A∃
→¬ VHhZ\X%¬→∨π,A∃π→ Vdh4\∩w≠U'(A⊃¬-
AβPA→ βM(@dh↓/ &~)→∃π→ zzt8[∃π→ ~∀~(~∃++=⊂t∩∩$∩w↔ ∃ A)⊃%&A++<A')+→ Aπ∨9)∪∂∪=+&A'<A)⊃βPA∂εA
β≤A'¬-
A∪P\~∃ I%∨$t$`~∀∪)%'(AU+∨⊂`4∃ %¬⊃ t∩∩$∩w'∨5
A%β9 ∨~AQ ∪ A→∨$A+U≡A↓β9 → $4∃++∨→≤t∩`$∩∩w!=∪∃) HA)≡A→+≥π %∨∀A U%∪≥∞↓)⊃
AU+∨⊂b↓→∨∨ 4∃++)M,t∩`4∃++)Q',t∩@~∃+ I',t∩@~∃++¬→(rt$∩]' ∀A++β1(∩w = '≤OPAπ∨≥→→∪πλ↓+∪)⊂↓++!'X~∃++A',t∩@~∃++=
.≥PI@$$KZ&→αLq↓*J≤*Qα6|"∃1α¬*QαN%*~→α|qαB∩`h*2V-~YuuRq6VV|@$$%]~RV~2αR"ε"α:⊗⊗%→αNε4J:≥α4zIαRD)αVVzα"ε:$b⊗H4TbN↑Mkii96≥:L$%]">Rεbα2⊗:="!α>2αNVB-⊃6↑JM"ε
2*αNRV404(&U∩NQα-*
.≥λh(4)[Ym↓)RQ)))RQαNR,2→αN
2⊗⊃α-α>9α-~⊗IαLrR⊗J∃*BQα,r∩MαD*J∃↓RQ)))RQ(4(04*≥*
RR`J~J⊗*αNR>∀
≡∃αdJNRMbαε:⊃∧:
αεt!αε2dz
αB
∩ε6⊗$*JL4Ph)mmZ↓)))RQ)))RQα~J,)αNR⎇∩ε≡∃∧b&NR~↓)))RQ)))RP4(4SYmmα$B⊗N∃∧
J∃α-~⊗⊃α∃IαR"*αZεJLzVMα≤z:N⊗∃→αR=∧
22>≤
R∃α≤*22M∧z_4)[YmαRD)αZε∀J>VM∧2J⊗∃¬~R>J :∃αN∧
∞⊗Mr↓α:⊗4*IαB-!α>:*α>→α$B⊗N∃∧J8$)[Yeα¬∧jεJ. ∩2∃α →↓"⊗D~⊗BQ¬:&B"Lqα¬α¬∩>B⊗∀beαB∀zR⊗∞$*⊃α∞|rN⊗IJλ4(4SYmmα≤
VR&|q¬α6-~QαB∀*N⊗J4)αJ⊗d
R&Z*α>J∩-∩& 4t t0h'73HH_he~dhkαd4iED44EHd4~HheRdhh"d4i∃D44¬Hd4
HheK⊂Q%e≤,Tλt_H⊃↔4<
((∀<*λ9tddX:D⎇⊂Q!PPLhj3PK↓⊃⊂K\I~5"∧j(T*¬:Iu∀ xT∧dM:APPLhkβPK↓⊃⊂K\i≠∧u,Z4αD hD¬∧t→XR∧ hD∧∀LyjTj¬yz$%~⊃Q L4iG K⊃⊃∪\4Iye,jλyu∀%4 DM≥AQ$$∩A_d4#!~4-%!⊃⊂K\IzT∀dUZ¬∀,9~4L|dλdd|jYU_h(;α Lhh3PM8ZEPH⊃↔4≤|Z D-B jTl∀X*0hTK∧@L4k' M≤ZK HH↔8D⎇,)HRm¬(X4M≤→yb∧≤yZ∧d-∧¬∧%- HUBHQ($: _hd∪P⊗↓⊂HK8)∀<uYT∧D,_HU∃_Q!∀4∃↔!∪H⊃↔5≥LX)tbα
d lUZEM∧Tλ∃$|U∀∧D,_HU∃_Q)∧r _hdCR
(U∧ ~D∧Dt9It:[∃D¬≤-K!∪LEYi5_h!_d4 !⊗HH↔:4
∃4¬∧
∃(≠∩¬∧y→e$-*5⊂hThhckk%eT451⊃⊂HK9jTl∀Z$∧|2λhb∧5)x%_h!_d5K'!∃≥K(→D_H⊃↔5≥LX)tb∧)It≤]4¬∧-E I∀≤MD
$-¬Z)b¬-8XBHh'73Z¬9_tr∧)~B∧Ldλd2j XT u4λUD,Z
B∧5)yRβ#¬Zt⎇∀D TLt→ZTj¬(X4d →XT"pQ!∩e≤XT∧<≥:yβλh!∃e≤,Tλ∀<≠~⊃PPJj8T*∧x8S∧≠QQ Ju8XR∧<8V∧≠HQ!∩u≤XT∧E,i1PPh'73Z¬
Z$*∧j(T*¬:Iu∀ xT∧≤⎇YjD-∃4¬∧t|eZ∧⎇≤~I∃4*D
$,d~I∃4*
Ir∧-λhbj∧(YD⎇:⊃Q#[[4 U-≥D
¬∀-8Z%4*
(Td
I~d*∧z(D-∀→hr¬$
)u,<∧ e∧4k⊗ hP→j∧457!∪H⊃↔4dM:APPLjλd5C!⊗HH↔8dMDjYPhP→j∧44G!∪H⊃↔44dyjThh(H" Ljλd4#!⊗HH↔8D⎇,)HPhT;∧@Luλhd≠P⊗↓⊂HK89tm∧H[hTK∧@LuλheSP⊗↓⊂HK8JU∧d[↓PT∀tA∀u∧hh#PK↓⊃⊂K\)_tu,QQ HK↓⊃⊂K\it¬¬-(T¬≥LX)te_Q)∧r →j∧44π$¬∀-λX∃"∧ i4d|u6∩bβ↓↔4E,i:0hP⊃⊗HH↔9dz¬
Z$*¬8~%_h)hd5$(92∧uλhe_h!→e∧4k⊗#PK↓⊃⊂K];→T∀|Dλ$d|9:0hPQ'3[Zλ_D%∀Z:2∧|d
t⎇∀Dλ∀∀⎇hT∧≥-*(Tu"
U∀*
8T<lYjB∧4z$∧, 9∧¬≥∧_8PhS772∧mZ:B¬¬(Z4-∃hT¬∀,H~DM4T u∀$Z)∀t:
I¬∀⎇Xyα∧-λheK⊂Q!∀-∧hj3PK↓⊃⊂K\I~5 h!_U∧4kπ K⊃⊃∪\4≠ e,hQ!∀-∧hiCPK↓⊃⊂K\iItu,QQ$$∩A_U∧4hG K⊃⊃∪\$zX$d(Q(5B _Z∧447!∪H⊃↔4≤|Z D-@Q(EB _Z∧45'!∪H⊃↔4%- HU@h((r LZλd4∪!⊗HH↔8$L<jYPhP⊃⊗HH↔9dz¬
Z$*¬;→T∀|J1PTDdA∀-∧hiβR¬(Z∧,
D ∧t\Ixr[
DεK\
Yd]_Q!⊂K⊃⊃∪\tt
¬-∀T
4
∃1Q$t4jH$≤ZλZ∧451Q L-λheK∪!⊗HH↔:5Ll)yB∧∀Ix4]_Q!PPLXjd≥≠!_%4≥8u4u4:8rU≤Xz4MP↔8Tt" xb∧≥Z*$,uD
d~¬(XtL|d¬∧,5h:2\tjh5≠lH~5"¬Z8T"¬h5⊂hP→he4≥π!∀uEh:4:⎇8z2-∧q⊃∪\uYX$-∩ xb∧-
J$
¬h4¬∧ xZ0hP_he4≠!_$54:1⊂HK:h∀e,Tλ4,dDλe∀,YI∃≥"¬λUE∧I_4M"
(U%-)d¬-≤XE⊂hP_ZE4≤iJ5βRε↓∩u≤XT∧<≤X~$XK8Zd-∩ZIt|ZZh∀e,UX4,dEXe∀|UYDM≥EZ5∧ 8UUh `h'73Z∧x9T\b ~2∧
*(∀t<XD∧dL8T∧
¬
)u∧-*K∩∧d~:CR¬IλRα∃
)u∧-*K∩∧t→XU~⊂Q'3[Zλ~$*¬8~%~b →b∧$X:$,
9→d:∧z(D-∩ xb¬∧z9∃$Lyd∧Lrλ~%∀
∀
5∧ 8U@hS772∧ hD¬$DT∧%¬∀zλU∃%∀
d eXZ2∩∧~(R∧4≠ e,m4λD,tzI∀t:
I∧*∧HYd=$
1PS[74∧|2
I∧*∧~*$
M5d¬-≤XD∧∃Jλx2b¬(ZE≥αDλu∀,H~"bα(~%∀
∃D∧ tD u$DZ*0hS772¬$t 4,-∧
E∀ 94∧|2λ~%∀
~5b∧tzHSR¬IλR∧Li~DL D t∀
*(∃J∧→h@hS772¬∀X_E$ )HR∧
(T∧t⎇D ∀r∧x9T\b
9∀t≤T
DD-∀λ∃∀* iu"∧→d∧∃¬5aPT<9Y4cP→_t≤l9APPh'73Z¬
)tdM4 ∃~∧→d∧ d~:B¬-8XB¬$t
¬∀⎇HX5"∧iybl
IyTL~
(T "YX∀≥∀qQ#[[4λe,t:I∀|u4λe∀|Tλ$,Lht∧<~xXBr∧X_4B∧~HTj∧yd¬$DQQ#[[4λ∀dM:D∧M~ xb¬$λT∧4⎇)TααDjYb¬∀JDαr∧jYRJα
y∧-∀W!PS[71∀5,d ∃~¬IλR∧5Yh5$Lyd¬$zλ(R¬¬)zD,≥HX@hS770M∀JD∧M~
I∧*¬8~"∧|d
DD*
(T %H_$d*λ9tt≤Z)d, Q'3[X→jTj∧~4∧
∧I~5α∧jYT∀-$¬∧=,~(∀u$XXB∧tI~5α∧→jTjHQ'3[X⊃↔D
≤9→∩∧≤λ~"¬4→JT+rλiu∩¬(X∀"lX_5∀zλjTt≥I→tph'73Z¬
)tdM4 ∃~¬ZλD
$XD∧∃J
:4<≥
)r∧ hD¬≥≤x:$,baQ%¬∀yI∃≠P→i∀`h!Q#[[4
d
∀→zU~¬(→d$|T
∧
∀→XU$-*4∧4⎇$λt
∀(_t*∧9yDd,:Iu∩pQ'3[Z ZU≥"
$-≤Z*d*¬(YD
$~hR∧⎇(HU∩¬y~DDLdλu∀⎇Z
2ph!Q#[[4λt≤l→d¬∧
(→T-$Z*2∧4z$∧, 9∧¬≥∧_8RαDiItu,T ∀42 Iα∧tyeUT-)u⊂hRj8T*∧x8S∧≠↓Q Llhj3PLY→d451⊃⊂K\I~5 h!→T45π!∀lLhhe@H⊃↔44M jThh!→T44G!∀lLhhd`H⊃↔44dyjThh(H" LXhd#P→Y∀t4hA⊂HK8Iu,∀HQPT≥∧A∀l4h7 Ll→hd4_⊃⊃∪\≤yZ∧d-↓Q$%BA→T45'!∀lLhhePH⊃↔4%- HU@h((r LXhd∪P→Y∀t4h!⊂HK8)∀<uYQPPLXheKP→Y∀t4k⊃⊂HK:;∀l∀yAPTDdA∀l4iπ"¬∀ZλT
" d\dxu3
b Y∀t4i↓∪\EYi5_h!→T44↔!∀lLhhdλH⊃↔5≤
*1PTthjD∀≤4 T451Q hS772∧dYhu$B xb∧5(XTdM:J2βd(Xd⎇∀UED 5HZ#ph%j4,*λx5β$!Q Lthj3PK↓⊃⊂K\I~5 h!→d45π!∪H⊃↔44M jThh!→d44G!∪H⊃↔44dyjThh(H" Lhhd#P⊗↓⊂HK8Iu,∀HQPT≥∧A∀t4h7 K⊃⊃∪\≤yZ∧d-↓Q$%BA→d45'!∪H⊃↔4%- HU@h((r Lhhd∪P⊗↓⊂HK8)∀<uYQPPLhheKP⊗↓⊂HK:;∀l∀yAPTDdA∀t4iπ"¬∀ZλT
" d\dxu3
bε↓∪\EYi5_h!→d44↔!∪H⊃↔5≤
*1PTthjD∀≤4 d451Q hT_ib¬-8YD-≥5)∃%~K1PT<:y∧{P⊗↓⊂K]h→E,* xbαE:H∃%-4λt≥< u⊂hP⊃⊃∪[
f∀βkrλI∃≥∧H≠∩∧lZ:4 <TλE-∀→hr∧<1Q HH↔6∩s∩πWb∧≤Ix$∀-$¬e<Dv$¬<MI∧∧<~
:D
$~:DL≥1Q$<≥y s P⊗↓⊂K]8~d,"
h∀e,Z4∧|2
y∧zlI→d*¬h~$L )HU~∧JZ$Lttλt_h(x5<Dv' KQ(t≥< v3PK↓Q%hH↔9∀4r
Z4,dZ:2TMJ1PPh(x4 ≥8~cPL)It≤Z h∀≥~6⊃⊂K\X~$\,Dλ∀≥~
8∃4,D ∧-∀QQ$<≤h~53P_)D|≤4ε#αkIh∀≥~6↔`HK:Ydl
)8T"∧_:2¬≤~hT"∧λZ$(h(x5βk(x4 ≥8~b]Q(t≤4JπST<8_5≤
e8deQ(t≤5
πST<8_5≤
e8eE↔:D-≥Dλt≤5
∧∧4⎇$ d|r[(U∀z
Ir∧$X9∀$* _`hTx:5βk(x4 ≥8~b]≥↓↔2∧Lj9∀$*λx2αD→Z∧eL→hr¬∀X→B¬∧ID¬∧|→jD-∃4λ∃∀* λU∀*⊃Q hUλ→dL≥π!∪K5V∩¬≤≠~2¬<Tz$*∧9Iu≤*
Ir¬∃YidLtt u-" xb∧≤YIE_h(x4m∀:g K↔9d|rYi∀b∧XX∀u~ X∃∀Z
∧
≤T tte⊃Q$<≥I→SPK↓↔4<~
I∀l(Q(t≥$V↔ KQ(t≥-Z:cPL)It≤Z JU-≥aQ$M∀ZhcPK↓↔4<≥Jx∩¬∀YYu4 D u4-*)∀$*
:tM$9↓PT<:)U3P⊗↓∪]<λZDD-$
Dz∧It∧<≥Jx∩¬∀YYu4 AQ$
∃λx5#P⊗A∪Z~ xb¬∧_xU~¬It∧=∀_$∧5∀XYEJ∧iz"∧
*(∃M~λ(T4⎇(T∧<_Q `h'73Z¬λ~$ lZHU∃~
(Td-h→e"¬It∧l,Yz%J∧→ID|≤~I∀|raQ#[[4 U-≥D
¬∀-8Z%4*
(Td
I~d*∧z(D-∀→hr∧|d T⎇≥D t2¬I ∃~¬:JT42aQ hS:Z4,"λ+∩∧<4
Dz∧ yD"∧[λ∀≥"λ8∀d≥YH∃$,D ∀u$Xz$ bλx4lLj1PPMS: 0 ;LIST
ZFFX: 0 ;FIXNUM
ZFFL: 0 ;FLONUM
DB$ ZFFD: 0 ;DOUBLE
CX$ ZFFC: 0 ;COMPLEX
DX$ ZFFZ: 0 ;DUPLEX
BG$ ZFFB: 0 ;BIGNUM
ZFFY: 0 ;SYMBOL
HN$ ZFFH: REPEAT HNKLOG+1, 0 ;HUNK
ZFFA: 0 ;SARS
NFFTBCK ZFFS
.SEE SSPCSIZE ;SIZE OF EACH SWEEPABLE SPACE. USED TO CALCULATE PERCENTAGE RECLAIMED.
SFSSIZ: NIFSSG*SEGSIZ ;LIST
SFXSIZ: NIFXSG*SEGSIZ ;FIXNUM
SFLSIZ: NIFLSG*SEGSIZ ;FLONUM
DB$ SDBSIZ: 0 ;DOUBLE
CX$ SCXSIZ: 0 ;COMPLEX
DX$ SDXSIZ: 0 ;DUPLEX
BG$ SBNSIZ: NBNSG*SEGSIZ ;BIGNUM
SSYSIZ: NSYMSG*SEGSIZ ;SYMBOL
HN$ SHNSIZ: REPEAT HNKLOG+1, 0 ;HUNKS
SSASIZ: NSARSG*SEGSIZ ;SARS
NFFTBCK SFSSIZ
;SIZES OF SPACES BEFORE START OF GC. COPIED FROM SFSSIZ ET AL. AT START OF GC.
OFSSIZ: 0 ;LIST
OFXSIZ: 0 ;FIXNUM
OFLSIZ: 0 ;FLONUM
DB$ ODBSIZ: 0 ;DOUBLE
CX$ OCXSIZ: 0 ;COMPLEX
DX$ ODXSIZ: 0 ;DUPLEX
BG$ OBNSIZ: 0 ;BIGNUM
OSYSIZ: 0 ;SYMBOL
HN$ OHNSIZ: REPEAT HNKLOG+1, 0 ;HUNKS
OSASIZ: 0 ;SARS
NFFTBCK OFSSIZ
;SIZE FOR EACH SPACE BELOW WHICH TO GRAB NEW SEGMENTS FASTLY
.SEE SGCSIZE ; (I.E. WITHOUT DOING A WHOLE GARBAGE COLLECTION FIRST)
GFSSIZ: MAXFFS ;LIST
GFXSIZ: MAXFFX ;FIXNUM
GFLSIZ: MAXFFL ;FLONUM
DB$ GDBSIZ: MAXFFD ;DOUBLE
CX$ GCXSIZ: MAXFFC ;COMPLEX
DX$ GDXSIZ: MAXFFZ ;DUPLEX
BG$ GBNSIZ: MAXFFB ;BIGNUM
GSYSIZ: MAXFFY ;SYMBOL
HN$ GHNSIZ: REPEAT HNKLOG+1, MAXFFH ;HUNKS
GSASIZ: MAXFFA ;SARS
NFFTBCK GFSSIZ
;;; ROOTS OF THE CHAINS LINKING LIKE PAGES IN THE GARBAGE COLLECTOR
;;; SEGMENT TABLE (GCST). FILLED IN AT INIT TIME.
FSSGLK: 0 ;LIST
FXSGLK: 0 ;FIXNUM
FLSGLK: 0 ;FLONUM
DB$ DBSGLK: 0 ;DOUBLE
CX$ CXSGLK: 0 ;COMPLEX
DX$ DXSGLK: 0 ;DUPLEX
BG$ BNSGLK: 0 ;BIGNUM
SYSGLK: 0 ;SYMBOL
HN$ HNSGLK: REPEAT HNKLOG+1, 0 ;HUNKS
SASGLK: 0 ;SARS
NFFTBCK FSSGLK
S2SGLK: 0 ;THIS MUST FOLLOW THOSE ABOVE! (SIMBOL BLOCKS)
BTSGLK: 0 ;LINKED LIST OF BIT BLOCKS
IMSGLK: 0 ;LINKED LIST OF UNALLOCATED IMPURE SEGMENTS (INIT SETS UP)
PRSGLK~ 0 ;LINKED LIST OF UNALLOCATED PURE SEGMENTS
10$ SVPRLK: 0 ;SAVED PRSGLK WHEN HISEG GETS PURIFIED
PC$ LHSGLK: 0 ;LINKED LIST OF BLOCKS FOR LH HACK
BTBAOB:
PG$ -<NBITSG*SEGSIZ/BTBSIZ>+NBITB,,BFBTBS←<5-SEGLOG>
PG% -<NBITSG*SEGSIZ/BTBSIZ>+NBITB,, .SEE IN10S5
MAINBITBLT: BFBTBS-1 ;END ADDRESS FOR BLT OF MAIL BIT BLOCK AREA
GC98: 0 ;RANDOM TEIP FOR GC
GC99: 0 9RANDOMER↓) ≠ ↓
∨$A≥ε~∀~(~∀]'∃
A'!U%'∪5∀∩w'∪i
A∂ ↓!+%
↓
%
↓')∨%¬∂
AβI β&@4A+' ⊂A≠β∪9→2A¬dA')βQ+&X~(]'
↓→ 1#Dd∩vA +(Aβ1'≡A%¬≥ ∨≠12A+'∃λA¬2↓ ⊗
k Aα~
~2>ε"α&*Rzα"&N,84(ε∧2NN&SP&:B5~N≥*≤*≡N&PH%n2M~P4λMα~bNMQh&:∧2bN≥U~⊗≡NMP$%n4Jb:Vhh(&B4bN&iPJ2B~e~≥*N,:N&hHIn~2|rV44T" ⊂&∧"
NεSP%@$HIfε&r:Qα:zα&:&$Jε1α¬*J∃α$zV
2-→1αN|r:e∧hRεa⊂Mα∞bNMQh%@HH%nεLq≡Qαtyα&:M"&ε1¬αVJ∃∧~>6BdJ∞⊗Mbα6ε6
λ4*∩B &B∩E~&ihK$$%\
&9≡"α:=αLr&R& aαBV∀)α∩V∧b&∞⊗~aα∩ε$"e∧4T∩≥⊂&∧∩:NεSP%@$HIfε&r:Qα:zα&:&$Jε1α¬*J∃α∀J≡:Vm→1α
∩e∧4PI@$$HInε&r:Qα:-2⊗IαtyαBV∀)αNfl∩>2Mλh*"9 JB":≤Jiiα∀*B⊗ε"α":.dz≥-Eb↓@%nE*:.MαBf>U∧:>RR
α
∃α\J∩∩&t9¬$4PI@$$HIfε&r:Qα:-2⊗IαtyαBV∀)αNε∃→α:⊗M""⊗Iλh*:~5"
∞-¬α~NNMP4(4PJBMJ≤Jih&u~eJN:RN⊗≡≤Jh$%]~f6
|aα
2|~.L4P04)[Ym↓)RQ)))RQ))αD
&Je¬αεJεl*R⊗J~α"ε∞\*⊃α
Jαε2∩|→↓))RQ)))RQ(4(hR
BNCP$$$HIf
&t
Jeα¬∩>≥α≥αε∞∃∧B&≡ hRB≥∀K$$%\2&2∩,!α&9∧∩eαεdb6 4Uα≥⊂%cb⊗:∩dJNA.∧
≡N&RiEy~∧
≡6N[q5D4Ph*
B≤ah&
∃αNN≤HH$%n∀J2εJJαBJ>:αNBε≤)α2>8h(4*L29αB :&:≥eX4*"Lrb5hK$%n "∩J⊗≥→α>→∧bεNQ¬:>J⊃∧z→α:Diα">d(4*tHIn⊗:"α>→αL29αB :&:≤hR&~∃¬αε≡&t92l4TB&b5PI@$%\
∩∩J-~Mα>2α2εN"α↑>J"α>→αdz]αN,:6⊗: h*6εDrb5hK$%nDJ≡"⊗≥!αVN ∩2∃α<zJ⊃α|1α:bjαε
>4)α2>:αN⊗≡l*:P4TB
B>∀9h&⊗t""$$KZ~&J≥!αεZ J2ε
d)α↑>∀!α>→∧B&N⊗:α~>I∧b>ε∩Lr≥α
LrεJe¬αJ>≡∀
6L4TB
B⊗t!h&&3 2mBjα&→IeZ"&2|→-qr,r∩"%lB&2>~jNR∩DI.Bε=~&i5 q~Bε<jN-yk
t4*hH%n⊗t!α>→∧J~∃α∧
≡&:8h(4)[YmαRD*N∃α%:=αZ bV⊗M∧
J∃α-~⊗⊃α4zIᬬ
V&∞Zjε:⊃l"&JRJαB∩1∧rV6
-⊃α∞",~-84RrN⊗∃¬α∩2:lX4):≤*∃αN∧*∞
&t %nεt!α>RD*JL4TrB∩2cP%@$KZ2>]∧*:⊃α|1α:Vl∩⊗Iα∧"1αε∀*∧4*uα∩2!PI@$%\B&≡!∧*:⊃α|1α:Vl∩⊗Iα∧"1αε∀*∧4(hP4*&4qαBε<J:≥2Xh*B∩d21EhK$%n4zIα~e*N"&t9αB∩bαBε≡-→↓5α≤*∃α⊗∀J:&PhRB∩24aIh%H%n~⎇⊃αVB$
R&::αNQ↓jαN⊗∃∧*J&:M 4*tHIn⊗:"α>→αL29αB :&:≤hP4)m[YαR"*α:⊗b"α~⊗]¬""&:=→α6V≥!α
∃∧J9αRDJMα>∀"⊗H4Ph):N,)αNN<~6ε`KZ6εbLjV5α≤Jj⊗M∧2>Iα≥">Jε<)αNB ~⊗L4PJb~~≠P%@$KZ2&N h(&b42ah%H%n~MB:V4hP&b~4ah%@HIn~2|rV44T" ⊂&D2~⊃hK$%n$zV
2(h*∞a Jb~~≠P%@$KZ∞>6∧b⊗`4T"a⊂&D2~ihK$%n%*B2⊗@h*
≥ Jb~~∪P%@$KZ
&≡u*44(MB~~ePI@$%]~f6
|`4*"r &b~4AiαJ-α⊗εQ∧B:.2|9-E1∧jεb~4@%n",r.L4PJb~~ P%@$KZNεJ_h*:~5"
∞-¬B~~LhP4*&4qαBε<J:≥2Xh)mmZαR"∃∧r⊗bQ∧2>VI¬""&:=→α6V≥!α
∃∧J9αRDJMα>∀"⊗H4UBB∩1PJ6εb∧"0$%\jεNR-⊃αB∩bαB>NM"&>:~αR=α<JR∀4UB~2APJ6εb4b@$%ZαB∩1lb>NN :∃α&u"⊗JJ-αRMα
4*b5BAh&l
b~bh*bN∧"1h&l
bNB$`4)m[YαR"*α:⊗b"α~>V∩αR"&t:Mα6-~Qα
*α&9α$B&Mα⎇∩∩⊗HhRjB∩cP&6εEα∩0$KZε∞R,
1αB$aαB>≤JR&>u→α~>∩α2>NLr≤4*T22AhLjεb~e$%nLr&R& b&j⊗"αεQα-∩&:&"α~J>jαbB∩bα⊗Aα a84*T2bAhLjεb~E$%m∧
:⊃α$J∩∩∩,!α
e¬α∩2>2αεQα⎇2⊗J~dz]αRLj∀4*U~B∩1PJ6εb≥α∩04Uh$%n,r⊃α>2α&~9¬αε≡&t84(Q'3[Z
I∧*∧h[¬"∧izU∩¬I ∀t=4 U-≥Dλ$*∧→d¬$D~4∧⎇∀HZ hT4' Jmλ_u≤M%9d ≥56∩[∩EJ∧$dz(rkλ↔:5$ hH∃∀"
(T:¬λIB¬¬J!PT4H6#PJZλ∀=≤≠%3∩bHiE∧⎇(qSλH↔:5$ hH∃∀"λiDz¬λIB¬¬J!PT5λ6#PJZλ∀=≤≠%3∩bHk¬∧⎇(uSλH↔:5$ hH∃∀"λi∃B¬λIB¬¬J!PU≤6' Jmλ_u≤M%0 %6K ∀jλ⊃∪tHq".tjH3Q⊂*(λ∀tλXh∀⊃ D∀∃∀AQNtpf$∩4h →R5∩(→∩6Q(D∃∪h yQ(∀iIuλ∩ _r⊃4D
∩⊂3D 21r
D⊂Q(λ[∀⊃0jH1β"G∀∩3@ zQ⊃4D
∪h⊂(8qs3)x⊂5⊃$λ(∪sHU4s∪jD∪uQ**∪tλ →H∀siX(∀∪λ_q4kAQKTq(T⊃4TJ tβ"K*plNA~t⊃∪ zQb"!⊃.tpf$∃r5 ∧⊗Q4It∪⊃1JD∩⊂3λa"C"G7nh∃ λ(∪Q+
λ⊃SjZH⊃∩ →Qth Z4uλλ((∩3D
∩∩4d tQ⊃*!"Spf'B,α'80Th I325
4⊃StD
⊃∪∀aQSqSλ6NB,↓QSqVλ6NB,↓QStpf'B,β! ↓A"Tu(*∃∪α*(3Q∪iT∃P4I_0S⊃*4∩3H Iuh⊂izQ#"AQNnhλl<⎇λ λu y∧ y;≠∞4→[|D
53s →Rh≤ml<≤~-lc"C!*4tR inB,↓⊃.q:.M→<Hε∧≠|Hλ83∪λ
≥\⎇≤N\⎇~;mgH~<d∞~~<d (≤| \z8;∧
≥;Zgq"Tq)h0 ;Either 0 or CALL instruction: send msg to user's hunk
ICALLI: 0 ;Either 0 or CALL instruction: Apply user's hunk
;;; I GUESS THIS STUFF NEED NOT BE CONSIDERED SACRED
;;; SPACE FOR ALL CHANNELS AND INFERIORS AND USELESS INTS AND GC OVERFLOWS
MAYBE LINTAR==20+10*JOBQIO+5*USELESS+NFF
INTAR: 0 ;INDEX INTO INTERRUPT ARRAY (FIFO QUEUE)
BLOCK LINTAR ;ENTRIES OF FORM <INT #,,ARG FOR INT FN>
; RIGHT HALVES ARE PROTECTED BY GC
;;; ENOUGH FOR ALL CHANNELS AND INFERIORS AND USELESS INTS AND GC OVERFLOWS
MAYBE LUNREAR==20+10*JOBQIO+5*USELESS+NFF
UNRC.G: 0 ;-2/-3 FOR DELAYED ↑X/↑G INTERRUPT
IFN USELESS, UNRCLI: 0 ;ENTRY FOR DELAYED CLI INTERRUPT
IFN USELESS, UNRMAR: 0 ;ENTRY FOR DELAYED MAR INTERRUPT
UNRRUN: 0 ;ENTRY FOR DELAYED RUNTIME ALARMCLOCK
UNRTIM: 0 ;ENTRY FOR DELAYED REAL TIME ALARMCLOCK
UNREAR: 0 ;ILDEX IJTO "REAL TIME" INTERRUPT QUEUE
BLOCK LUNREAR ;EJTRIES OF FORM <ARG FOR INT FN,,INT #>
;ARGS IN UNREAR NAED NO GC PROTECTION
.SEE NOINTERRUPT
;;; INTERRUPT PDL
LIPSAV==:10 ;LENGTH OF CRUD PUSHED BY INTERRUPT
IPSWD1==:-7 ;WORD ONE (.PIRQC) INTERRUPTS TAKEN
IPSWD2==:-6 ;WORD TWO (.IFPIR) INTERRUPTS TAKEN
IPSDF1==:-5 ;SAVED .DF1
IPSDF2==:-4 ;SAVED .DF2
IPSPC==:-3 ;SAVED PC
IPSD==:-2 ;SAVED ACCUMULATOR D
IPSR==:-1 ;SAVED ACCUMULATOR R
IPSF==:0 ;SAVED ACCUMULATOR F
MXIPDL==4 ;MAX SIMULTANEOUS INTERRUPTS
; (CALCULATED FROM THE DEFER WORDS
; IN THE INTERRUPT VECTOR):
; 1 MISCELLANEOUS
; 2 PDL OVERFLOW
; 1 MEMORY ERROR/ILLEGAL OP
LINTPDL==LIPSAV*MXIPDL+1 .SEE PDLOV
INTPDL: -LINTPDL,,INTPDL .SEE INTVEC
;EXTRA ROOM FOR ONE INTPDL OVERFLOW AND RESULTING EXTRA INTERRUPT
BLOCK LINTPDL+2*LIPSAV .SEE PDLOV
IT$ IOCINS: 0 ;USER IOC ERROR ADDRESS
IT$ .SEE IOCER8
IFN D10,[
IFN SAIL,[
;SAIL ONLY DEFINITIONS
ACBASE==:20 ;WHERE SAIL MONITOR SAVES USER ACS UPON INT
INTMAI==:004000,,000000 ;MAIL INTERRUPT
INTPAR==:000400,,000000 ;PARITY ERROR
INTCLK==:000200,,000000 ;CLOCK INTERRUPT
INTTTI==:000004,,000000 ;<ESCAPE>I INTERRUPT
INTPOV==:000000,,200000 ;PDL OV
INTILM==:000000,,020000 ;ILL MEMORY REF
INTNXM==:000000,,010000 ;NON EXISTANT MEMORY
] ;END IFN SAIL
REEINT: BLOCK 1
REENOP: BLOCK 1
APRSVT: BLOCK 1
REESVT: BLOCK 1
] ;END IFN D10
IFN D10+D20,[
INTALL: BLOCK 1
;FUDGE BIT DEFINITIONS FOR VARIOUS ITS PI BITS
;LEFT HALF BITS
SA$ %PIMAI==:4000,,
%PIPAR==:1000,,
%PIWRO==:200,,
;RH BITS
%PIMPV==:20000
%PIILO==:40
] ;END IFN D10+D20
;;; LH OF MUNGP => GC IS IN PROCESS OF USING MARK BITS
;;; IN SARS OR SYMBOLS
;;; RH OF MUNGP => ALIST IS IN PROCESS OF USING LH'S OF
;;; VALUE CELLS FOR SPECPDL HACKERY
;;; ERINIT CHECKS MUNGP AND ATTEMPTS TO RESTORE THINGS IF
;;; NECESSARY.THIS SHOULD HAPPEN ONLY IL THE CASE OF SOME
;;; GROSS BUG LIKE A MEMORY VIMLATIMN.
MUNGP: 0
3+; VARIABLES NEEDED FOR EBRPOP
ERRPAD: 0 ;SAVE RETURN ADDRESS
ERRPST~ 0 ;SAVE T OVER UNWPRO
;;; TEMPORARIES FOR FASLOAD
BFTMPS::
SQ6BIT: 0 ;TEMPORARIES FOR SQUEEZE
SQSQOZ: 0
LDBYTS: 0 ;WORD OF RELOCATION BYTES
LDOFST: 0(TT) ;LOAD OFFSET (RELOCATION FACTOR = VALUE OF BPORG BEFORE LOAD)
LDAAOB: 0 ;AOBJN INDEX FOR ATOMTABLE ARRAY
LDTEMP: ;RANDOM TEMPORARY
LD6BIT: 0 ;PLACE TO ACCUMULATE SIXBIT WHILE CONVERTING FROM SQUOZE
; - FIRST 6 BITS OF NEXT WORD MUST BE ZERO
LDAPTR: 0(TT) ;WILL BE AN IN@IRECT POINTER FOR ACCESSING THE ATOMTABLE
LDBPTR: 0(F) ;WILD BE AN INDIRECT POINTER FOR ACCESSING THE I/O BUFFER
LDF2DP: 0 ;.FNAM2-DIFFERENT-P
; (NON-ZERO --> FASLAP'S LDFNM2 DIFFERS FROM CURRENT FASLOAD'S)
LDASAR: 0 ;ADDRESS OF SAR FOR FASLOAD'S ATOMTABLE ARRAY
LDBSAR: 0 ;ADDRESS OF SAR FOR FASLOAD'S I/O BUFFER ARRAY
IFE PAGING,[
LDXBLT: 0 ;BLT POINTER FOR ZAPPING CALLS FOR XCTS IN BPS
LDXSIZ: 0 ;0=XCT HACKERY NEVER DONE, -1=DONE AND PURIFIED,
; N>0=LENGTH (IN WORDS) OF AREA FOR XCTED CALLS
LDXSM1: 0 ;CONTAINS 1 LESS THAN LDXSIZ, AND RETAINS VALUE AFTER
; LDXSIZ BECOMES -1
LDXDIF: 0(D) .SEE LDPRC6
;RH WILL CONTAIN DIFFERENCE BETWEEN RH AND LH OF LDXBLT
] ;END IFE PAGING
LDHLOC: 0 ;HIGHEST LOC ASSEMBLED INTO + 1
LDEOFJ: 0 ;JUMP ADDRESS FOR END OF FASLOAD INPUT FILE
10$ LDEOFP: 0 ;USED FOR EOF HANDLING IN FASLOAD FOR D10
LFTMPS==:.-BFTMPS ;NUMBER OF FASLOAD TEMPORARIES
IFN PAGING,[
;MULTIPLE XCT SEGMENTS ASSEMBLY TIME PARAMETERS
;DESCRIPTION OF SEGMENT FORMAT:
;LDXPNT POINTS TO FIRST IMPURE SEGMENT IN THE CHAIN. THE RH OF LDXPSP
; WORD IN EACH SEGMENT IS THE POINTER TO THE PURIFIABLE SEGMENT ATTACHED
; TO THE IMPURE SEGMENT, AND THE LH OF LDXPSP IS THE POINTER TO THE NEXT
; SEGMENT OR 0 IF NO MORE SEGMENTS IN CHAIN. LDXLPC IS THE -COUNT OF THE
; NUMBER OF SLOTS FREE IN THE CURRENT SEGMENT. THE CURRENT SEGMENT IS THE
; ONE POINTED TO BY LDXLPL. IF LDXLPC IS >= 0, IT IS POSSIBLE THAT THE PURE
; SEGMENT ATTACHED TO C(LDXLPL) IS ACTUALLY PURE, AND THUS MAY NOT BE WRITTEN
; INTO. IF LDXPNT IS 0, THE DATABASE IS COMPLETELY INVALID.
; THE SEGMENT SIZE USED IS THE DEFAULT SEGMENT SIZE DEFINED BY SEGLOG AND
; SEGSIZ. IF LDXPFG IS -1, THEN A PURIFICATION HAS BEEN DONE. THIS FLAG IS
; USED SOLELY FOR (STATUS UUOLINKS). AN EMPTY SLOT IS ZERO IN BOTH THE PURE
; AND IMPURE SEGMENT. THE FIRST WORD THAT IS USED FOR DATA IN EACH SEGMENT
; IS LDXOFS. THIS IS COMPUTED SUCH THAT THE LAST WORD OF DATA IS ACTUALLY THE
; LAST WORD OF THE SEGMENT.
;HASHING VALUES
IFE SEGLOG-8.,[LDHSH1==:251.
LDHSH2==:241.]
IFE SEGLOG-9.,[LDHSH1==:509.
LDHSH2==:503.]
IFE SEGLOG-10.,[LDHSH1==:1019.
LDHSH2==:1021.]
LDX%FU==:90. ;WHAT PERCENTAGE FULL ANY PAGE IS ALLOWED TO GET
;THIS MUST BE LOCATION ZERO!
LDXPSP==:0 ;NEXT SEGMENT IN CHAIN,,PURE SEGMENT POINTER
LDXOFS==:SEGSIZ-LDHSH1-1 ;OFFSET OF FIRST WORD OF UUOLINKS
LDXPNT: 0 ;POINTER TO XCT PAGES
LDXLPC: 0 ;COUNT OF WORDS REMAINING ON LAST PAGE USED
LDXLPL: 0 ;STARTING LOCATION OF LAST PAGE USED
LDXHS1: 0 ;FIRST HASH VALUE
LDXHS2: 0 ;SECOND HASH VALUE
LDXPFG: 0 ;-1 WHEN PURIFIED
] ;END IFN PAGING
αIT$ IUSN: 0 ;INITIAL USER SNAME - SET BY LISPGO
USN: BLOCK 2 ;USER SYSTEM NAME
EVPUNT: TRUTH ;DON'T EVAL FUNCTION ATOM
IFN D10,[
UWUSN: 0 ;UWRITE SNAME (I.E. PPN)
D10PTR: 0 ;AOBJN POINTER FOR DEC BUFFERS..
D10ARD: -200,,. ;I/O WORD FOR ARRAY DUMP AND FASL
0
D10NAM: 0 ;THIS WORD ;WILL BE ###LSP WHERE ###=JOB NR
D10REN: BLOCK2 ;FIHE NAME TO
] ;END MF IFN D10
¬
IT% CYMLO: 0 ;LOS BOUNDARY FOR DDT'S S@35¬∨_AQβ¬→
4∀~∃∪→≤A'β%_Y6~(w
%≥∃α≤z6∃α-BRJ¬¬"Reα∀*2εR,!α
&%_4)⊗%BR>AkiiQAβ%m
$zA α\*e84R*RbN4auui∪↓A@%Z∩N"&5!62≡≤Y α.-I84)-"bN~#iuiEβ↓@%m∃~"&~"⊃α.⊗Jp4)⊗%B6R¬kiiQAIm
6-"¬ α\*e84R*Rb∞$auui∪↓@%m∀~>:R∀z1 α\*e84R*Rbε≤→uui 9\%n$B∃αε≤~&%α∧
JQα|1αR"*α∞"ε∀
∞R⊗∩p4*TKZ⊗:⊃∧J~9α≤
&04TJQ⊃↓-"bN~ciuiAα↓m
NDJ~Q6dz∞- ∧Z⊗eα$z⊗N9=!α⊗bM~Qα>pα&RLhP4*J$zα)aPJJ⊃bpIn>I¬∩⊃b]∧2>Iα<B&R∃=→↓-αD
4* b≡∞→PI@%n4bε≥α$yαNR⎇↓αR"*α≡
α<B&"∃∧J9αεdb6 4T
~&2∀!h%5λIm%Eβiyα:zα&*&"α~&2*a↓yAβiyα∞%⊃α>→∧
22≡~α∞.6l*:P4Ph*≡:,ih&ε≤~&%αd9AAA¬`%n&tJR&εbα≡⊗:≥J44(hP4)M[YαJεt"> *
:E,4dλd⎇∩λ(∀t$yP∧e,X(U∩∧xYd-∀~Iu⊂h'73J¬)iu-~D
$∀ 95B∧ hD¬∀∀Ix4Z∧XZ5"∧(T∧LRλI∧
" z$$-%aPPh)_dr¬Z8Td-:5EXh)X∃L∀T E∀∀Ix4[kW&s
p⊃↔2β;∀∧β≠(Q)T
L(T¬∀|j8U#kW&3*p⊃↔5Bα¬;ααα6∀∧M~ ~%∀,JX4L∀HT∧l|Dε"αD~92∧l_:5Ll∀∃⊂hUQ⊃∪\,hD∧|2 _dr¬Z8Td-:1PTLhT¬-≤YHU≥~K1PTl≠_$*∧J($d|97SkSq⊃∪Jα∧∧ααα∧∧αααεtαβ_Q)T
L(T¬∀|j8U#kW&0HK:9r∧ J9r∧M4 αα]∧¬3
∧~*$,%X9∀∀dT T|"ε!PUh⊃↔4,tD t2∧_hR¬-8YD-≥1Q hU)iu=≠!⊗Ju8XR∧Li~$t ↔9∀tMI_∀dM(XB∧
D ∀tMD
DLlQQ%∀∀_93PK↓∃e≤,T
5≥∀→hD|h↔84 rλ(R¬∀Z:D⎇∀XD∧∃J¬
5≥$~JU~¬(→d$|T¬brr⊃Q%∀∀Ix4[Rλ)D|≤4 E∀∀Ix4XJj8T*¬(→d$|Q↔3;
d
t⎇∀J4∧|2∧*$ tIyR∀tZ:0hPQ!PP`h*)e$s'!∩rEE⊃∪\≥Z*$,uD
∧t∃Xd¬<⎇(D∧4⎇$λ4|mλ~$*∧yd∧LuHZ$ph!Q#[[4
d
∀__$d-4λd⎇∩λ~%∀
∀λ∀ddx8∃$⎇!Q$∃¬ j#PK↓↔3e≤≠(R∧|dλ∃∃∀≠∀∧D,_HU∪rEESe≤≠(R∧|dλ∃∃∀≠∀∧$
H↔`hTx→Tu#!⊗K\jYT∀-$ t2¬yz$%~
(U
,~(T"b yb∧
λ8∀db
Ir∧<ZJ5h(z4∃∧g!∪K:Z4,"λ~2¬$YZ∧⎇∀~+∩∧∃λYd"¬y ∀d*λ)E"<→hr∧$zyb∧
*(∃M_Q(∀$%8~#PK↓↔4 $J(U≥~ xb¬≥λX4L Dλ∃∃∀≠∀∧≤,ID¬<DYd∧l 9→b∧
*(∃Hh*Iu%≥λ7 K↔7B~∧xd∧
∃(≠∩∧$→Z3rbGJD⎇$→D¬≥∧_8R∧tXXD,"λiu∩∧~*$
KaQ$dd~ε∪PK↓↔3dd~(t-≥D D,<→D∧LtH[α∧|dλ∃∃∀≠↔b[λQ)∀u≥π!∪K:
4-,IuU∧$D
∧|LjHU∩∧iz"∧
*(∃Jl→hphPQ!PU∃J:β P⊗↓PU∃J:β≠P⊗↓PTdz8T3P⊗vpK\H~α∧|)(T≥"
:D⎇∀_xRαjλXd4L9_Tt≥∀λd ≥Iz"rαλiu∩α
:D
%Z4∧d⎇8XbJβT bbQ!⊂K]IλU∀*
y∀dbλ(Rβc≠ycrk∀
5$⎇(XB∧DZ(Rrα
9∃T* xb∧<4
¬∀⎇HX5$Lyd∧
∃(≠⊂hTyHE≥Dλ~4Eβ!~E∃-I∧K\_dβjα¬∃B¬$λYb¬-8T∧t-t
5%LHT¬≥Dλ~4Bb↓Q%∃<w!∪K9_bβjε¬B¬$λYb∧≥(X∃$*λZ%∀⎇$ tr∧I~dL$Tλ%J¬(Z$zb↓Q HH∀π4⎇∩λiD|
I→d:∧zhddz yb∧≤yjd-∃9→tr∧xd∧∀LyjThh(iD⎇3_↔ K↔:$ tIyR¬$YZ¬~∧iz"∧4Ix∃$Lht¬∧|→j@hTiIu3L'!∪K4 u4-(iD⎇: →e$-**U¬" λ∀t$HZ hT: %≥;!⊗K\_d∧t⎇D $-∀uD¬$DYdαU∃8ZB¬<~4∧|rDλ∀t"λ(∀]%(_4*¬y→Db∧i→d"∧ZX4BQ!⊂K\→hd⎇∀X~DL|dλe∀|T
DD*∧ 45,eED≥∧z %jα
K∃∧*
:E,4d tr¬IλR¬∧IAPU¬;→T3P⊗↓∪\tyeUT-)t∧%-)→d:∧[λT≥-I→tr∧xd¬¬≥→U`hU xd3P⊗↓∪]4~)∀⎇-4
$⎇-I→d-~ →e4|Ji∀t:∧Kα=~λj$|jλHE"∧It∧U≥$z2∧DZ(PhP→*%≥"
5Lk⊃Q%¬≤Z7 L∀Ix4Zβ&↓∪]$ ~2¬≤ zTd"λ(R∧,izT<Bλiu∩∧J
4m$!Q L∀Ix4Zβ1Q%¬≤ZJ3PK↓Q%¬≤Z*3PK↓Q$M"A~5
,{(RβαEa∪\4z$∧
α¬h%∀,→4β ∩K6Bbe
5e~k≠QPU¬5j3PK↓⊃∩u≤XT¬¬≥→V⊂hPQ*5% J[#PK↓↔44⎇$
4-%→→d:∧i→B∧⎇$
Bαj
(Tl,X(U∩¬y ∀≤B yd*∧zhU∩∧→jE< ~APPh)iu∧4J7 K↔9d|r[(U∀zπWb¬¬Z)∀5JHt¬≤DzYD$rzD∧4eZ9α¬∧IJ0hPQ*4
=:π Jk⊃↔5≤≥(Zrl
)zTt"Zy∃$BZ9∧
∀→hrmβ$∧αk
8∃M~
xR∧mZ4¬∀,_DhP⊃↔2∧⎇Z$∧≤⎇(T∧Ll_xR∧Ldλe∀|Tλ∩α∃
Z% Lt$∧4LHQPS∪∧D¬¬≥~:βPJV∀K]
Z$L5∃Z5M≥HYRm∧_xU~α¬V∩¬≤≠~2¬LZ1PPh(→E5∀iw"∧
89∃R¬F @K\~84LJ∞>G⊗Nltπ>OM∧∧dM:∧π6/.=⊗}r
nVn⊗↑$αjj∞<W"π↑↓PPH⊃↔2αε≡D∧Lt~I∀ d≠(Rπ&≥\Rph!Q$L4d ∃%~K1PU¬Z(D-3!⊗K]λJTmαλi∀d*λHU4L8T∧t XQPU¬Z(ds !⊗K]λJTmαλi∀d*λicλh*
U∀4f' K↔:∧%,Z∧∧4LHT∧4s!Q%¬-*9dkP⊗↓∪]∧JYUα∧i→D*¬9h∀l(Q!PU≥~8D-3!~4MD)~B¬e;~5`h*;∃≤4f↔ M≤≠λ$M" J¬-∃→→u`h*;∃≤4f' Leh)dxh*;∃≥≤iW M≤≠λ$M" J5M≥AQ%hH↔9∀4r ~E_h!Q%≤
Dλd \HJCPLλ→E H↔8d⎇∩λh∀\Lht∧⎇-D
DD*
yu∀dAQ hTX≠∀∀* J4T≤H*T3kV⊗HK8Yd⎇,y∧∧4⎇$εCαrλ9∧
∃1Q%≤T9H%,3!⊗HK8i∃∃≥D
t⎇∀D ∧|dD e,l(Z"∧|dλ4D
*4∧∃,hhU∀,AQ L∀Ix4Z∧J9$≤d*X`hP⊃⊗HK9→e≥-(Z2¬$λ~B∧LHH%~¬y→Db∧i→d dK∀¬≤,Tλ∩¬TZ)phP`h*:T∃%IA∀Lt~I∀ b
(T %H_$d*D t∀
*(∃Jα →b∧dzt∧≤⎇(U⊂hPQ'3[Z →dM$_→B¬∀X_B¬≥→jD
B
H∀∀dT ∀r∧iz$j∧xd∧ rλ~%∀
⊃Q hP∃V∩bc↓⊃∪\Ld d-<→uB¬<→IB¬∧y→e"¬It∧l :)r∧≤λ~"∧d~:@hU*;¬$∪↔!∃¬-9∧¬αd8i∃CλQ!∀U≥∧
E"c_I∀l0Q!∩αα
(T %H_$d(Q!∩ααε↓PU∀:G L∀Ix4Z∧J(5"k!↔5<D_9α∧M4λ$e"xD∧Lrλj$|j
(5#Q!∃%∃ZIαbc↓↔2E≥H~E-~
JEM∀X_BJbE
5$
JZ2∧ (*$-4_~D*HQ!∀tLEEE%∃ZIKZ
:D
%Z4¬$-*
$JJEE¬≥$~JU~¬u∀ααQ!PPh!Q#[[4 ∀tMI_∀b∧x)DM≥D ∀r∧iz$j∧xd∧
∃(≠⊂hP∃WD|∃J9∃R[↔es∩bI→t∀
&!PTLx(∃∪ !→%≥α
JBc I→U_h!∀αα∧x(∃∃∀≠⊃PPJ∧∧∧|∃J9∃R[∃6#βQ)∀|∀~&#PL)It≤ZπIt∃%9≠"[ ev hP_)D|≤4ε#βαv!∪]≤→htd*λ9∧
∩ x$U~
H∀∀dT¬∧≥∀X~D,"λ~2∧tXXD,"⊃Q hPQ `h*:T∃%IA∩¬¬Z*D∀bλ→d"∧~
U∀Li≠⊂hPQ'3[Z
U∀*
λ∀<*
H∀∀dQQ#[[4λ4|uH→∀u~
Jtz∧)~E~∧iz"∧,_9α¬∧_xRbβ⊗d¬∧ xZ2¬∧Z$¬$ )HR¬<z(@hS772∧lX→dLtt t2∧)~E≠P⊗εβlu Q⊂Kβ↔Y∀m¬Z(PhS770HH⊗⊗βm¬Z(PHK⊗↔U≥∧X9∀ b λ∀≤\Z+∩∧tXXD, Q!PTLid¬∧ y→d:e1Q hU
Z%$∀G!PTLf∃EXh$↓∀∀dx92∧uλ_u~{&↓PTLid∧u∧_z23 uD∧∀dx92βλQ+PK\YhB∧Lf⊃PTLf%EXh++%;kUa∪\$~)b¬<YIB∧∀ZJD-∩λ(R¬≤_hR∧⎇hZ"¬$λT∧4|IIu<Lht∧l-:4⊂hRh+∃$*ε!PUU+'SkQ$Ckk1↔44⎇$ ∧ M+∀¬¬∀→jD⎇-D
Dz¬yz$Xh*
$LuK∧¬`h)→dM$_→B¬¬Z*D∀b XTl⎇+∀∧d
→zU h+6βlu UBβ Y→U¬-(UBβ∪Z
U∀*D∧Cl∃
5u∧$Ez4≥∀~H4EhQ+@hPQ)dd∃J8skk↓Q$tD*J4;kV↓PTLid∧d|)~E≤:A→dd∃J8sklh)∃%≤qQ"t,J8R`H→i∧∃%8wSlt)~E≤8Q!PS[74∧Lr
I∧*∧~*α∧∀YIu:bλ9tll~4∧ tDλ5∩=4 T
∀4λu,
(→e$,XD¬∧ xT∧∀⎇YhD
∀_Z0hPQ)∃∃α
:∧≥~EK5T-%9D∃"J:Be≥~5E≤
%:d~e
h2dM6%5≥LU;¬D
K ¬Re;⊗"]∧k¬5∧55:∧4b; ¬h)_e~\_kα\LiE4∀r; ∧∩dλ*Bd∃
5DuDUHeEαKλeEαHiEαeλiEαe¬K¬h*:αeESCR]BIPS,,[1,1,2,1,0,1,0,2,1,1,$,0,$,0,$,0,$,0,$,0,$]
ZZX==0
IRPS SPC,,[SPCS]
ZZX==ZZX+N!SPC!SG
TERMIN
REPEAT XZX/SGS%PG,[
BITS
ZZZ==ZZZ+1
IFE ZZZ&17,[
0
0
]
PRIJTX \BITS\
IFE <ZZZ#10>&17, PRINTX \ \
IFE <ZZZ#20>&37, PRINTX \ \
IFE ZZZ&37,[
PRINTX \
T
]
] ;END OF REPEAT
TERMIN
.BYTE
IFN ZZZ-NPAGS,[
WARN \ZZZ,[=WRONG LENCTHFOR PURTBL (SHOULD BE ]\NPAGS,[)]
LGC ZZW
BLOCK NPAGS/20
IFN NPAGS&17, BLOCK 1
] ;END OF IFN ZZZ-NPAGS
PRIJTX \
\
] ;EJD IF 2
] ;END OF IFN PAGING
.SEE PURIFY ;PURIFY ENTERS HERE
FPURF7: MOVSI F,2000 ;THIS BIT CONVERTS CALL TO CALLF, JCALL TO JCALLF
MOVEI T,VPURCL
PUSH P,T
FPURF1: HRRZ T,(T) ;CDR DOWN THE PURLIST
FPUR1Q: JUMPE T,POP1J
FPUR1A: HLRZ AR2A,(T)
PUSHJ P,LDSMSH ;TRY TO SMASH
JRST FPURF4 ;WIN
IORM F,(AR2A) ;LOSE - MAKE IT A CALLF/JCALLF
FPURF4: HRRZ T,@(P) ;WIN, SO CUT IT OUT OF PURCLOBRL
HRRZ T,(T)
HRRM T,@(P)
JRST FPUR1Q
IFN USELESS,[
IP0: ;PURIFY/DEPURIFY SOME PAGES
IFN D10, JRST (R) ;C HAS FLAG, NON-NULL MEANS PURIFY
IFN D20+ITS,[
LSH D,-PAGLOG ;CALLED BY JSP R,IP0
LSH TT,-PAGLOG ;USES B,C,T,TT,D,F
CAIGE TT,1
LERR [SIXBIT \1ST PAGE NOT PURE!\]
MOVEI B,(TT) ;FIGURE OUT PURTBL BYTE POINTER
IFN ITS,[
ROT B,-4
ADDI B,(B)
ROT B,-1
TLC B,770000
ADD B,[450200,,PURTBL]
SUBI D,-1(TT) ;CALCULATE NUMBER OF PAGES
IMULI TT,1001
TRO TT,400000 ;SET UP ARG FOR .CBLK20$ MOVSI 1,.FHSLF
SKIPN C
TLOA TT,400
SKIPA C,R70+2 ;IN PURTBL, 1=IMPURE, 2=PURE
MOVEI C,1
IP7: .CBLK TT, ;HACK PAGE
JSP F,IP1 ;IP1 HANDLES LOSSES
ADDI TT,1001
] ;END OF IFN ITS
IFN D20,[
ROT TT,-4
ADDA TT,(TT)
ROT TT,-1
TLC TT,770000
ADD TT,[450200,,PURTBL]
SUBI D,-1(B) ;CALCULATE NUMBER OF PAGES
HRRI 1,(TT)
HRLI 1(.FHSLF
MOVSI 2,(PA%BD+PA%EX)
SKIPN C
TLOA 3,(PA%CPY)
SKIPA F,R70+2
MOVEI F,1
IP7: SPACS
ADDA 1,1¬
ADDI 2,1
] ;EN@ OF IFN D20
TLNN B,730000 ;FOR BIBOP, DEPOSIT BYTE IN PURTBL
TLZ B,770000
IT$ IDPB C,B
20$ IDPB F,TT
SOJN D,IP7
JRST (R)
IFN ITS,[
IP1: MOVE T,[4400,,<776000+<SFA*1000>>];ASSUME FAILURE WAS DUE TO SHARIL¬∞~∀$]π¬→,A(X∩$w+' LA∨≥→dA(Y)P~∀∩@9→∨'
b```,K ≥β
$∩w≥<Aπ∨%∀Aβ-β%→β¬→∀~∀∪→⊃∧A(Ylbbb`@`XY)Q:~∀∪1'⊂A(1!β∂→=∞Vdd4∀∪⊃%I∩A(XpfnlWM
α|UAβ∂'∪h@w'≡↓π↔!2↓!β∂
↓∪∃)≡↓'∨≠
↓
β↔
↓!β∂
4∀∪¬→PA(XxLnlW'→α|U!¬∂'∪4,bnnns→∪↔∀A!β∂∀A≥+≠ $@f\l∩∀∪5∨-
APY)(~(∪β≥
≠∩A(0fnn~(∪∪∨%$A(Xf\lW'
∧~∀α]
¬→⊗APX∩∩w5∨-
AAβ∂
A5β A
=$@fnXA∪≥)<A→∨'%≥εA!¬∂
A!='∪)∪=≤~∀∩]→∨'∀~∀β≠=) ∩APXfnl@``FyM
αTb@``|~(∩]π¬1⊗A(X$∩w
→U'⊂A 9)%2A→∨$A!¬∂
@f\l∩∀∩]→∨'∀~∀∪∃I'(@Q_R~∃:$∩w ≥⊂A∨ A%
≤A∪Q&~∃:$∩w ≥⊂A∨ A%
≤A∪Q&Wλd@~∃ 4HIn⊗:"α>→αL29αV≤*2⊗N_h(4(04λhRNF
%"0&N$
JQ6-↓α∞≡$)1αε5"⊗Iα
α~2V≤B&:≥¬~VNB,r⊂$(hQn*>$B&:≥∧z9αRDJMαB :∃α&~α~2V≤B⊗⊃α<B⊗9>L1α2&≥↓≡Mα¬*J∃α∧
≡⊗M∧
J∃α≤b⊗εJ,!α~J|h4)m∧~>J∃∧"VJ&t9α¬α≥*NB⊗t 4(4TJ~9α∧
≡&::bl4(hR:~2≥→ih4Ph*~2≥"
1hhR&→Ebα
2>≤Y↓qq;9]]]=y6N⊗<b>≥y[ y=M2p4*&3⊃2l4Rr
fR*↓D4*M∩AαN∧~M12]R⊗I.d∩Q2N"bNfMe~εI.4→2bZ~b&MI]~f5.EB¬2bEQ2Ne∩ZB~a]α~M.∧21.bE4*&5→.&~BZ&~1\∩9.bD⊃2"
"b
BMdrb525BA2b5BA2~e↓2b~e↓2A2E4*NαbbNAe~∞Jv∀JRM1eYE1Ec⊃1E1αaE1Ac⊃1E1
a⊃1Ab!1A1"aA1⊃c↓1⊃1αa∩t4URjauk4*&∃αMαN∧→12n≥α∞NthRjjakjjja\qεNB~
N≤4U"⊗J6Lp4*J-α⊗εQ¬Rja>≤:M⊗B:bl4*L2∃α
M"M5Ib↓D$$KZ≡⊗:-∩εR∃∧ α~2-~!α⊗u"JeαL1αBV∀(4):,bN∃0K$$%Zα⊗2N*αBε≡*αN">,b⊃α:⎇!α
∃∧22VND*⊂4*hh*R⊗∀j&84Rr
fR(h*
2|~-↓qc9]]];:⎇6N,:2>≥rYEy=≠195qrj~2N$∩1x4Uh$%n,r⊃α>2α&→HhRt$%\*:⊃α|1α&~rαBε≡Lr≤4(hP4*&4qα⊃Iαbl4*,rRZ⊗≠Qα*J≥!α2&≥α≡<$KZR>B~iIAα,rRJe¬2⊗∞R⎇⊂4(&U∩NQα≥"J2≤hP%AHH%nRzα
∃α4J22⊗"α&9α<JR!α4*JN&|qα:Vl∩⊗IαLq4(HH$%mα↓α
&%→↓Q92↓5↓Ms84*tKZ⊗:⊃∧z→α&4qα⊃Ih(4(hR&~9∧JRNr#⊃A2lhR~2N∧ Eh&
~∞&i¬ahn+}⊃αOW∨β↔;∪. l4*`h*~2≥α¬MhL
N∞&RαqhndJNAβπ+K∃βε ∨↔Mε33WOF+⊃1β∞s⊃β+}⊃αOW∨β↔;∪. l4*`h*~2≤"&∃hhR∩⊗~Lr∃α~d"&6N:α∧4*
~∞&i¬ahn2⎇~∃¬¬αα∂π;v{Qβ≠Ns⊃β≠Nc∃β←O#!βC/∪∃βC∞;↔Mβ6{IβSF)α2&≥↓β←#N≠!βSFKMβ+}⊃β←π~β∪W7ε+⊃β≠⊗{5↓#6+KO'}q↓ε¬
I84*`h*R⊗∀j&84Ph*~2$J6N≥¬b2ZJtz84(hP4*N-~AQhhR&~9∧JRM2Xh(%:≤
21α¬*J∞"Xh(%↓u2ε2V*α~2N$J∀$%Zα∩&∃bα∩&∃bα∩&∃∧J→α:zαNfN$*5αB :⊗L4PJ*V6∧)αRQbq5D4PJ*JN"αNVNβ~∧4(hRt%n,r⊃α>2α&~9∧JRL4TJ~9α#⊃A2lhP&6>4*%α¬d∩NfN≤:⎇5r≤*≡2>:ZN≡M-α≥5Eph(&"∀b%α¬br~"Nd04(&∃αε∞LhP&R2t)α 1Eα¬⊗B-A$4(Jα*JN"αNVNβ~∧4(LBJJ>J↓E2~e~∩&∀hP&BN⎇*P4(LRJNQαq5H4Uh%n⊗t!α>→∧J~9α#⊃@4(hR~2N≥"εJR-↓h4(LRNAα%!2N"
∩AD$KZ
⊗~⎇∩∃αN$
JR&t9α6V≥!α"ε4)α¬α∀*ε1α≤zJ∃αLjε≡∀hP%α*∃~QαN-~AP4U~VNA≤ h&N-"j5α≤
↑N@HIn↑∃∧BεZ∃∧
2J⊗ "eα6
αB⊗⊃∧zVJN,bZ⊗M∧J84(hRt%n,r⊃α>2α&~9∧JRNr#⊃@4(hP4)m[Yα"⊗∀)α>9¬~RεJ%*Aαε<
&9α 2R⊗I¬~VNB,rN&>ph*NV≥↓Mh$hR&~9∧!EBr#⊃A↓↓α&*Nαα→2*≤bN⊗PKZ≡>
∀b∃α∩⎇:9αεuIα*∞`h(&6⎇2∃α:La2≡∞t
NY-λInJ⊗≥">J∃∧J6B>∃"ε:Q∧
≡LhP&6>4)αQ2\:∞:ε≥1-I1d2J⊗⊗ ~t4(L∩2Qα"aE\4PJN⊗RT⊃α¬2⊂H%n∞d*εIα⎇*Qα≡
∩
ε≡(h(&N-"j α~bεIDhP&N⊗%QαεI∀ 04(M~.&Br↓"~2αH$%n∀*NR>∀)α~bααV:2-~Mα*≤aα↑ε~α:&0hP%α6⎇2∃α~E↓1"~E↓$4(Lj>Z:JαQ1DHInε>∀R9α>r↓5Eαd*εZ⊗~αmE1cαuα>rα¬α. @4(L
>
*rαQ19[λ$%m∧∩VQα[αuα>rα¬↓α\aα>I∧Z$4(Lj>Z⊗jαQ2. B@4TJ~9αM"Nr⊃∪↓2l4PJ6>Z*αQ2≡≤rεNXhP&6>4*5αQdb&NB≥84(&U~AαQe~"εJ-$%n∀)6J⊗ !αBV∀)αBε<*Mα&2α⊗Z⊗∃JR"&t9α&M∧J9α>∀"⊗H4Uh%n⊗t!α>→∧J~9αM"Nr⊃∪4*&4qα&R~bl4(JrNVN-!αm:∀zBR&|q12R%h4(&$b=αR"b>BRLrQ.>¬">B HIn:⊗:jNRfd)α&:$*JJV¬"Mαεt!α:=¬α
αN≥∩⊗↑ε<(4(%u~VN⊗"αm:N⎇αR&>ra2RRhh(%:≥*N⊗Q¬Y:N∩3 12I;αt4(JrNVN-!αm:≤"→I1e⊃]BthP%:N-~⊗QαZrN6ε≤Y12&l
N.thP%:N-~⊗QαZrN6N[⊃12&l
N-Jhh*&~rαVN⊗d*NM2Xh(&6⎇2∃αQdJ6εNXh(&R∀r∃αQb*B&6
⊂4(%αrNVN-!αm:≤jεJ¬bbNεZl
Jt4Uh$%n,r⊃α>2α&~9¬*N⊗2-~L4*hH%n⊗t!α>→∧J~9αM"L4*L29α⊃∪↓2l4PJ6>Z,IαQ2≥"J2≤HInJ⊗≥">J∃α∩∞>:$J:V∃∩αε∩∩∀*NL4PJ"JJjαQ2⊗u"Z⊗
[λ4(&U~AαIe":bN- $%nm*NQα∀)α∩>t)α
⊗4zJ∃α∧J>84Uh%n⊗t!α>→∧J~9α#⊃@4*L29α⊃ ↓2l4PJ6>Z*αQ2≡≤rεNXhP&"J T,.JBSA"
HLRM T,.JBREN
SA% JSP T,D10SET
] ;END OF IFN D10
PION
JSP T,PPNUSNSET
SETZM NOPFLS
HRRZS NOQUIT
PUSHJ P,OPNTTY ;*** TEMP CROCK?
JFCL
PUSHJ P,UDIRSET
POPI FLP,1 ;REMOVE NIL VALRET FLAG
POP FLP,A ;RESTORE RETURN VALUE
POPJ P,
NOSHARE==JRST (T) ;DEPOSIT INTO SHAREP TO INHIBIT SHAREING
SHAREP: SKIPN SAWSP
JRST (T)
SETZM SAWSP
IFN ITS,[
.CALL PURCHK
.VALUE
JUMPL TT,(T) ;NEGATIVE IF FIRST SYSTEM PAGE IS WRITEABLE
] ;END OF IFN ITS
JSP TT,SHARP1
JFCL ;IGNORE CASE OF LOST PURQIO FILE
JRST (T)
SHARP1:
IT% JRST (TT)
IT% WARN [HOW TO SHARE WITH "PURQIO" FILE?]
IFN ITS,[
.CALL SYSFIL ;GET SYSTEM FILE AND SHARES - SKIP IF WIN
JRST (TT)
.CALL SHRLOD ;LOAD ALL PURE PAGES FROM THE FILE
.LOSE 1400
.CLOSE TMPC,
JRST 1(TT)
SHRLOD: SETZ
SIXBIT \LOAD\
MOVEI %JSELF ;MYSELF
MOVEI TMPC ;CHANNEL ON WHICH PURQIO/PURBIB IS OPEN'ED
SETZI 0 ;LOAD ONLY PURE PAGES
] ;END OF IFN ITS
FLSLSP:
20$ JRST FLSNOT
IFN ITS,[
.CALL SYSFIL ;IN ORDER TO FLUSH PAGES, WE MUST BE CERTAIN
JRST FLSNOT ; THAT WE CAN GET OURSELVES BACK!
.CLOSE TMPC,
.CALL PURCHK ;ONLY FLUSH IF LISP IS PURE
.VALUE
JUMPLE TT,FLSNOT
SETOM SAWSP ;FLAG THAT WE MUST READ OURSELVES FROM THE FILE
MOVE T,[440100,,FLSTBL] ;POINTER INTO TABLE OF WHICH PAGES TO FLUSH
SETZI TT, ;KEEP PAGE NUMBER IN TT
FLSPA4: ILDB R,T ;GET INFO ON THIS PAGE
JUMPE R,FLSPA5 ;SKIP IF NOT FLUSHABLE
CAIE TT,NFLSS/PAGSIZ ;NEVER FLUSH THE PAGES WE ARE ON
CAIN TT,NFLSE/PAGSIZ
JRST FLSPA5
.CALL FLSPA6 ;ELSE FLUSH THE PAGE FROM OUR PAGE MAP
.LOSE 1∀00
FLSPA5: CAIGE TT,777777/PAGSIZ ;LOOP UNTIL HIGHEST PAGE NUMBER
AOJA TT,FLSPA4
.SUSET FLSMSK ;MAKE SURE NO INTERRUPTS TRY TO HAPPEN
PUSHJ P,PDUMPL ;PURE DUMP LISP IF SO DESIRED
SKIPE (FLP) ;NIL JCL?
JRST SUSCON ;NOPE, RETURN T AND PROCEED
SKIPE TT,(FXP) ;CHEAK IF VALRET STRING
JRST FLSVAL ;YES, MUST VALRET IT THEN
MOVE T,FXP
SUB T,FLSADJ
MOVEM T,(FXP)
.VALUE FLSPA3 ;PRINT SUSPENSION MESSAGE
JRST SUSCON ;CONTINUING AFTER A SUSPEND
FLSVAL: SKIPN VALFIX ;IS VALREP STRING REALLY A FIXNEM?
JRSTFLSVA1 ;NO, USE FORMAL VALRET
∪⊃I%4A(0bQ)($∩∩w!%β↔+ ↓)⊃
AYβ→+
4∀∩]¬I β⊗@DlXQ($∩∩w <A)⊃
]¬% ¬⊗~∀∪)%'(AM+'π∨8∩∩wπ=≥)∪≥U
A/⊃∃≤A∪(↓% )+I≥&XA +(A%∃)+%≤↓(~∀~)
→'-∧btα]Yβ→+
bQ)($~∀∪∃I'(A'U'π∨≤$∩w∨≤↓!%∨π∃ λXAI !+%8A(~∀4∃
→'¬ ∀`(K 11DhR~2Nm~-h%u~6εNZa19-λh(%Aba@4(hR~2N∧ Yh&≤*Rh4PJN&b∀JQαr≤zJ
2]`4(&lzZ⊗%β$$%\22VNBαR"∃¬αε≡∀hP&6>4*%↓⊗U~⊗2_HIn~J|iα>V∃~⊗2Z-_4(&≤*Riα% $$%]αε≡∃∧rV6
-⊃α&9¬"P4(hRBVJ≤B-h&≤*Rh4PJN&b∀JQαr≤zJRf¬`$%n<*QαRMα∃α~⎇⊃α∞>∀)α
2|~,4(J↓↓EAβ↓12
≥JNN≥⎇αε≡NMP%nRD
Qα~M∩NQα≥JNR⊗jαBε≡*α&Mα|p4(%#↓IAAαa2RPHImyA¬∩⊗ε⊃lz:2eb↓q↓A¬:J&R ∩2∃1βi↓Aαtz96⊗DJNR⊗u 4(∀U~fN~Lah&N-"h$$KZ~>I∧zB⊗:Lr≥αVαα~&2*αR=α≤BεJ∀hP&N&D∩&QαdzB⊗:`h(%↓α↓↓αNM~∞"8hP%↓↓α↓αNf≤"⊗X4PI↓↓↓ααNfN4qD4(J↓↓↓↓¬~fN~s⊂4(&≤*Riα≥JNN:hh(4*≥JN∞"sP%:VLI12Rmα 4(hRt%n,r⊃α>2α&~9∧JRL4Ph(4)]∩>VRLr∃αRzαB∩Vm↓α¬α4J2∃α<JR!αLr∩&J,~QαNLj
>1¬"ε
2*αB>&u"⊗IαLr∞2V$*⊂4(hR&Q∃¬α∩V6∧ah&B⎇α)αA`h*&~rα&RMeX4*B%*6B1PJN.&∧qαBV∀"⊗X$KZ∩&⊃¬""∃α=*eα↑ rQαB-∩∃α∩,jB&:;x4(%¬α>B)¬↓0$%\r>B∃bαJ⊗R-∩9αJL:"Qα
:εd4PI:∞εdaαBV∀zB8$KZ>B⊗rαR"∃∧2&2∃∧2>Iα∧"V6A<J:≤4PI↓:2⎇~∃↓E#↓@$%]""∃α=*eα2⎇~Q1α|Aα↑⊗da1α↑*αεJ∃¬αJ>
∩2eαLp4($HH%mα
αNVN∧*:⊃α rf↑εHh(&N-"iαQ`H$%n∧"V6A¬∩⊗FVM∩⊗Mα qα&:M"ε22Jαj⊗JzαNRε$)α↑>∀ 4(%t~ε21¬α∩V6H%n∩zαR"∃∧
∞RV aαB∩,j@4(J↓:2>≤)↓EQβ4(%tJ>Qα$jB
2¬*JNRHIn>V%αVQα≥"εJQ∧J:NR∃*∞R&|p4(%tJ>Qα$jB
2¬*J&NIn&:$JJ⊗∞"αNf6∀z1αR ∩2∃α∧z&:R-⊃α&:$J∞εR⎇⊂4(&lzZ∃α%!2BV∃αRH$KZB>&u"⊗Iα$yα~&d*:ε6-_4(&lzZ∃α"bBVJ¬"H$%]~RεJ"α∞"⊗≤ZNV4hRBVJ≤ZMh&∀zQαQcλ4(& "⊃αQbBRQ$HInε:"α∞"⊗≤ZNV5∧2>Iα$"P4(Jr&>Q¬"6B
bBRQ$HInε2≤yα>V%αVQα$B∃α↑⎇∩⊃αRzαR"∃∧2&2∀hP&ε>∀R9αR"bBVJ≤ZL4(Jr&>Q¬"6B
e $%n⎇*RBV"αR"∃∧~"⊗∞]~V44PI:&>"αR6B~bBVJ≥"$%n$B⊗9α :ε&9¬""∃α≥"εJQ∧
∩H4PI:∞εdaαBV∃∩↑<$KZJ⊗: j∃αRzα∞>J∀*∞Qα4J2⊗: j∀4(J↓:2>≤)↓EQβ4(%t~2>N*αR6B~`$%n4J:&NBαVAα<JR!α$B∃α~Lb∀4(Mα>B)¬↓04(hRBVJ⎇α9h&≤*Rh4PJN&b∀JQαr⎇α⊗:phP%↓↓α↓αBV∀~"84PI↓↓↓ααBVJ$*X4(J↓↓↓↓¬αVJ>βλ4(%α↓↓↓α¬*J>A⊂h(&N-"iαB-∩N:4hP$4*¬*J>A P&N&D∩&Qαbr2&Nαrp4*¬*J>A∪P&N&D∩&QαdzVRB-"p4(hRBVJ∃:=h&≤*Rh4PJN&b∀JQαr∀*:6↑⎇`4(&lzZ⊗%¬"6B hP%↓↓α↓αBV∀29D4PJN⊗RRαBVJ4qH4(hRB∩Vm↓h&N-"h4(M~&b
M!αrB%*6BphP&6>4*%↓⊗U~⊗2_hP&6>4*%αRmα 4(M~⊗Ri¬ 4(4UαVJ∞Dqh%:,J=12$jB 4UαVJN$Ih&*∃~Qα2M~B≡<hRBVJM~Ah%k!11HhRBVJ¬"Ih%k!12NM~∩⊗XhP4*tHIn⊗:"α>→αL29α&%_4(4Uα≥⊃αt22N∃Ph(4(04(hRNV
%"1α.Lb"≡!∧
:⊃α<*R"≡@h*&~rαNε&bbl4**rNRε∃!h$4PJN⊗R|iα∃:∧Bε:R|h4(&lzZ⊗5β92Z⊗Tz
:Vhh(&6⎇2⊗5↓αb∃*~L`4(&lzZ⊗5β 2∃:-BP4(Lj>Z⊗j↓M2∃uαB84PJ6>Z,i↓Y2*r∩⊗XhP&6>4)α¬25!:&RHh(&6⎇2⊗5α
bZ⊗∞ b2⊗∩h(&*∃~Q↓↓
AEA$HH%nJ-"VJ9αY↓D4Ph*∃:∧Bε:R|ih%@hR∃:~Lah$&≤Jb
&"αqα⊗Lr&RphR∃:⊗E!h$&≤Jb
&"αr&:M`4*∃uαB9hHI@4**r∩⊗YPH&N&D∩&Qαd"N.phP4*tKZ⊗:⊃∧z→α&4qαNεL`4(4TJ~9αDJN⊗≡l*:Q2Xh*&~*αNε&bbl4*\J2"≥#P&>V%~RIα\
N∞&Rαp4)\s?Qβ6cWO#Ns≥β#N;!βO.;7↔;"↓5β∂∞q∨Qβ6K;⊃↓u~"Iβ6K3∀4Ubt4*\J2"≥∪P&6>4*%α¬dZ&2α;_$%n$B&Mα≤B>V2"α
∃α≥"εJQ∧
∩IαL1α:>"α.&2dJ:≥αE_4(&E∩J5α
a:*
≤λ4(&lzZ∃↓αbN≡εt
4$%\J6B>∃"ε:Q∧J:~=∧J:R=∧
∞MαLqα∞ε≤)α>→∧~>:RLrV∀4PJ6>Z*↓EE2≤:ε∩⊗0h(&6⎇2∃↓]e~≡εB∧p4(ε-B&Q↓
`$$%]~VNB,r⊃α~⎇⊃α¬α<B&2∀hR.&2D9Mh&lzRε5β↓2N≡ rε44PJ6>Z,i↓EEe~≡ε∩-04(εlzZ⊗5β92N≡
αB84PJ*JN"αJ⊗RD: $*hH%n⊗t!α&~*αNε&`h(4*\J2"≡CP&6>4*%α¬d:⊗Rα<@$%n\J21αDJ≡!α≤*≡6⊗u 4(&E∩J5α
a:*
≤ λ$%]~⊗Qα≥"εJQ∧
∩∩J-~L4*L2∃αN J12lhP&N.Mα9αN-~~2LhP%α*∃~Qα.Lb"≥HhP&N.Mα∃αN<
:ε4HIn∞εr:Qα~e*N!αDJ≡!α≤*≡6⊗u!α&→¬:∀4(JαN.&∧qαN≡ "⊗X$KYα∩>r:Qα.tz]α↑D*J⊗~∀z5αRzαJ⊗R∀J⊗Z∃∧JP4(J↓α*J≥!α.&dB≥P4PJ6>Z≤Iα¬1λh(&∞⎇∩∃α¬`H$%n4bVN!∧B&≡!¬~⊗≡6,rP4(Jα*~∞`h*.εdB≥EhhRt$%\*:⊃α|1α&~*αNε&`h*&~rαNε&bbl4(M~.&B*αNVN4bL4(M~.&BrαN≡εt
44(Jα*JN α.&2D9D4(Lj>Z⊗Jα¬2~ Z∩∩PHIn~>zaα">:α6ε:Jα↑εf~α∞ε9¬~ε&1∧b>N∃xh(&N\JB9↓tR
∩∩ H%mαTz
∩∩"α6VN"α
∃αtz96j-∩=αRzαNεZ*λ4(%¬~⊗R∩%!α¬0HImα>$B⊗J↑M~∃α6
Iα~εLaαR=¬~εZ∃∧*:R&∀)α2>≤*≤4(M~⊗Ri∧ 04(L~>J∃∩α¬0$KZ~2V≤Aα"&<AαN⊗<j⊗:PhP%α" bP$$KZ">]∧~ε9α<)αB>≥~&
2Jα2>N+y↓""
α"¬$hP&*J≥!α.&dB≥H4Ph*.&G1: SKIPL .JBHRL
JRST KILHG2
MOVEI A,1
SETUWP A,
HALT
KILHG2:
] ;END OF IFN SAIL
EXIT 1, ;"CONTINUE" WILL FALL INTO GETHGH
IFN SAIL,[
JSP 10,E.START
] ;END OF IFN SAIL
GETHGH:
IFE SAIL,[
SETZM VECALLEDP
MOVEI A,A+1 ;SET UP TO GET HIGH SEG BACK
MOVE A+1,SGADEV
MOVE A+2,SGANAM
MOVE A+3,SGAEXT
MOVEI A+4,0
MOVE A+5,SGAPPN
SKIPE SGANAM
SKIPN SGADEV
JRST GETHG1
GETSEG A, ;GET HIGH SEGMENT
JRST GLSLUA
GETHG1:
] ;END OF IFE SAIL
IFN SAIL,[
JRST .+5 ;DAMN RPG STARTUP ON SAIL
RESET
CLRBFI
JRST .+2
RESET
SKIPE .JBHRL
JRST GETHG1
MOVE T,SGANAM
ATTSEG T,
SKIPA TT,SGADEV
JSP FREEAC,CHKHGH
MOVEI T,.IODMP ;OJ FAILURE, LOCK THE SHB FILE, THEN TRY AGAIN,
SETZ D, ; AND OJ FAIL@∪≥≤A≠β↔∀A)⊃
↓⊃∪' ≤A∨+%M →- L~∀&⎇α⊗9α$jB
2 H%n>∧*9αVα↓2N"∩α~&2*α∩εZL~∃αεpα∩V6αα6>∩(h(%αD
2P$HIfN>l)α6>∀z9α≡
2∃αIz4LTt
4,≤yhB∧
(t¬$z
:U≥∧YhCxh!→T⎇4T
Be≤x→d hQ!∀l]hT¬%"J8t -
APPM8ZER∧EAPPLxZE≥%4
Dm∧5J HK8xU"∧9λ∀ttYD¬≥$~JU~¬yz$ H!~E∀z
!C β∧↓⊂K\h~5"¬(X∀"l→JD-⊂Q!∃≤-J:E~¬IZ∧~Bλ!⊂HK8Ir∧MAQ LlzhR¬∩J8t
¬ aPPLIyt]-∧
Dm∧5J@hP∀ %∃≥Dλte≤JX⊂HK9ItlZ
Zααu9
"∧4→HPhP→Yu *h⊃K
! B5
+H⊂
* ⊗XDDNβSE NOS OPEH A∪PA
∨$↓%ββλ5β⊂∩R-⊃α6>$)α~>⊂h &N-"iα⊃`H$%@4
DD(⊂ gS P ⊂URPOSE OF PRAVENTING↓_∞B"-⊂4(→Yu$
λ
8p4∀ a".` )pThλjSs
(01∩)hβP$jλ* ∂O, THEREBP∩~(∪ ≥)∃$A)≠AεQ(∩$p
α∞
*N&:8∧¬ 824Q∧
P0q$λssQ ~⊂∧gg∀FE∧P∩))j GH '→Uα~∧∪5∨%
APY'∂β9β~4PJεBR≤*≥αQ`H%nN,)α&→¬~>&⊗|r∃α⊗e~∃αλ~2¬≤→XR∧D~8T;ZλI∧M~λ8∀pH!∀¬≤\~λ∩¬"Ha⊂KZ λ∃¬∧Y`∧L2λ9tl* zDD
$ $|∩λxU%~
I¬∀⎇Xyα¬$ ~0hP∀∧∧U≥∧λe∀,X_2d≤ 9∧<@↔4∧≤|HT∧∀-JxT,r zU∩∧i~%≥"λ~E%≤Xt∧ tD
DD*λYe$-!Q Llzie~¬A⊃⊂K]Dλt-%4 D,TzIα∧|d¬e≤E$λdLdQQ L HD¬"bi(%∀,AQ LE*$¬∩bi(%∀,A⊃∪\mZ:B∧<x($d*
9tl*λ9u∧LZ4∧|2¬i$∃∀YAPPL
*%R¬JEBtT*(T`H↔4∧∀,iz$*¬IλR∧≤z(R¬-Yt∧≤D→ht-~ ~@hP_9u∀*
E@HH↔8UE$YhB∧dz8T:∧+∀¬$D~4∧ lzYe h!∀∧U∃:D∧<e9K#λh!~4-%$λb`h!→∀r¬IZ∧~e!⊃∪]∀X_B∧Ld ∧M≤XqPPJ
94M∧∀
Be≤x→d hQ!∩α∧**5"∧HJ4≥∃QQ M$It¬%"I
4<⎇(q⊂K]z)∃$*
$⎇$X:B∧D~8T8h(xU$Dv' M∀YX∃α¬JE@HK9HU"=4
5∧d~APPJ *%≥"λyE≤e&1PT<ZI∧; !Q LlzhR¬"J8t t→QPRα∧∧ααα↓~4-$iV"¬"AQ J∧λ→E h!~$,dX~4*¬IZ∧~`⊃↔44eZ9α¬$YZα∧≤λ→dt,D¬$ 5HZ"R∧:(T
$→hr¬$λT∧DM8XphUQ⊃∪\,hD∧|2 _dr¬8→∀`h*(U$Dyπ LU*:Bαp⊃⊃∪]∀ZJU∀rλ_D%∩λ9D|∀(Z$," →b∧DZ(PhPQ(te≤J[∪PM9≠∧∀MD D≤ iiu"∧xZB∧D_yα¬≤XyT,uD≠@hTyJ4e,↔!∀l⎇hY∩∧~HyE≤e[⊃PTLid¬≤ →EEXh!~$,dX~4*¬IZ∧~`Q!∃$e$
E"bV⊃PPL8→∀*¬JED-∀h)R(H↔84|dI~4L|dλE,*
Ir∧dx94⎇-GqPPJ *%≥"λyE≤e&↓⊂K\iuB∧<YjU<LhT∧d⎇:8∀<(Q!∃∧Tx$¬%"A⊃∪]$ ~2∧M4λ∀db
$-%K∀¬∀ hItjαT
t*=(QPPL_I∃4J
JBc8⊃↔2¬%+→∀t: *U≥"λ∀∧dMJID*∧)~B¬$t
4|ehQPPM9HT-αλE@HK4
DD* λ∀M∃∀
$ ≤Tλ4|tI~DL|j4αD Iy∧
⊃Q LU*:B∧<ZI∧<@Q!PT≤ 9∧<C!→T⎇4TλBe≤x~¬∧pQ$αα_8∀l*λEE¬≤z
∧ph!∀∧U∃:D∧<e9K# h$∧αLYzd*∧EJ4< HZ`hP_8∀l*λEE¬≤xHU0h!∀∧U∃:D∧<e9K# h!→T⎇4TλBe≤x_UE Q!∀≤ XT∧"e
8t-EAQ J∧**5"∧yJ4eSAQ LlzhR∧"J8t t→Q⊂K\9λT≤Z ∃≤,t
d d_H∃$Lyd¬<⎇(J0hP_8∀l*λEE¬≤yh∀hh$↓∩∧U*:B∧<J9ES Q!∀U∃:D∧<-Iλsλh!⊃PT<J9ES#!~4-%$
B`H⊃↔5=∀yhr∧D~8T:b
9r¬TZ)r∧MD u-"λ→d"¬:H∃∃"λ_t LaQ L≤z(S∩¬EAPPJ *%≥"λyE≤e&⊃PPLYzd*¬JEE≤<_HU0h!→T⎇4T
Bd0Q!∀U∃:DαD5(XT ~⊃Q hTyJ4eSπ!PUh⊃↔4,tD t2∧_ib¬≤→→@hP→
$dJλ5C##εfβH↔:tLdD
$, Dλ∩¬≤≠λ$M"
:E∀LhqPT<J9ET !→∀d$$
Bd_⊃↔5∀,_D¬≥%)→d:∧→hB¬%~λR∧MAQ L HI∩¬"D$α⊂H↔84|uhZ%"¬It∧
≤9→⊂hP→zU$≤
$¬ h!_4 LT
Bb∩∀!⊂K]:Iuα∧_jD-∩λ[∧≤d→X∃$LyeU∧|→j@hP∀ %∃≥Dλte≤K(⊂hP_[∧M ⊃⊃∪\4yqPPh)_dr¬8→∀be1Q hTyJ4eS↔!∀⎇-J:E∩∧yJ4dk⊃Q L- ~@hTyJ4dk↔!∀
≤9≠"¬cx9u∀*
ZTz∧Iz5 h+APPh(yE≤e&' L⎇ZJ5%∩λyE≤dV!PPL[ ∃ h(yE≤dV' L
89∃R¬Gy∀r¬ZYr∧dz:@hUAQ hTyJ4eS7!∀⎇-J:E∩∧yJ4dk1Q LU*:B∧<ZI∧;⊂Q(te≤IV3PL~84MR Gu∀,X~αεf}>BαjT
fzε-|"π≡M}G~ε≡l⊗Nf≤-F*b∞,W'↔≥≥f8h+APUh⊃↔4,tD t2∧_ib¬≤→→@hPQ!PU≤x→d k!Q%≤
Q⊗HH↔:DD-8T∧
∀T
DD*
8∃4,D d lZ4∧4⎇$λt-%I→d8h*8∩ M9≠∧∀MD Dl 9J5¬`Q*4< HZcPh*8∩(K↓⊃⊂KZ
I∧*∧ _tB¬8Xtl,jD∧∀ 94∧ 5HZ"¬≥Z:∧,u9→tph*8∩ M9≠∧∀MD E≥M;APU≤x~¬∧s!⊗HH∃j4,*
:U≥∧Yh@hU8x∀-EG!∃≤Mλ)∃"¬J9¬∃`⊃↔5≤|XT∧d⎇8Z"∧l_y¬"¬x→e"¬It∧≤D→ht*¬I ∃_h!Q hS772∧≤xHR∧4z$∧4
9It "
Ir¬∀X_B∧Ldλ∩∧tZt∧DLy∧¬≤,yXTu"aQ#[[4
DDM4λ4|$T U-≥Dλ$*∧→d¬$DT D⎇:
8T<lYjBλh'73Z¬D ∧
~ HTt=I∧∧|2
I∧*αj9¬∩∧i→D+Z IαE∩∀ ∧
~ hT<
I~d*∧xd¬$D~5`hPQ)D%∀→
3Ph)_d*¬8→∀be1Q Llzj4J¬JECλh!_4⎇∀T
E"`⊃↔44eZ9α∧|HD∧DLy∧¬≤,yXTu Q!∩∧U*:B∧dJ85∃(Q!∀E∃+$¬%"Ei$∃∀YA⊂K\:Z%∀,jD∧DLyλU≥"λ_D%∀Z:2∧Ld D⎇≤XqPPL
*%R∧EEdT∃(Y@hP→
%∩¬%EdT∃(Y@hP__D"¬JEE h!_4⎇∀T
E"`⊃↔4-Eλ→d"∧Iz4,:
9r∧≤→d∧D|HD∧≤⎇ ∀∧|2 ∃≤,qQ J∧**5"∧HJ4≥∃Q⊃∪Zα
(Tl,X(U∩bλ8∀r=DλDz∧∃yr∧LjIr∧D~8T:
⊃Q M≤ZK"∧2AQ LLd
Dm∧5J HK:(T " →bαu9
"∧4→HPhP∀λ4 L⊃Q Jα *%≥" HE≤≥*QPPM(YT
αλE@HK9iu:∧X→4*∧∀ ∧M≤Xt∧5∀yT¬$DT
$, EY∀r∧9xD(h!∀∧U∃:D∧d%8:%(h!~4-%Zzα∧2A⊃∪]$z
2k ∧
¬∀⎇HX5%~
Z2∧5)yR∧⎇Z*4,ehZ2`h!∀∧U∃:D∧d%8:%(H↔4¬≤z
xR∧mZ:B∧l→8R∧D~8T:¬z)∃$ )HRαDd ∃~¬(Z$zHQ!∃≤-K)R¬≤x→d h⊃↔5<* ir∧dyht-∩ 9d⎇:
I∧*∧ _tE≤Xt∧t XT⊂hP⊃⊃⊂K\_d¬$D~4∧M~ itrm(Z$zb ∀<BZ8T:∧xZE~∧iJU≤DXAPPH⊃⊃∪Z∧JZ$Ltt¬¬≥-:λTt"∀λ∀t"λ→Db¬IλR¬≥JXd2¬xTu4(Q!⊂HH↔4∧$|hT¬$z ~B∧<xZ2∧∃_X%L*∀¬∧
∀t∃⊂hP~ u∧R
¬@hUQ⊃∪\,hD∧|2 _d*¬8→∀`h)_dr¬8→∀be1Q M≤ZK"¬%EAPPL9z$+∩
JB`H↔8de-9∧∧|dD ∧L<∧
4,<XYe h!∀∧U∃:D∧d%8:%(h)HE∀E6↔ L≤z(S∩¬EA⊂K\X→4*∧∀ d-:¬
u∀MH_$d*∀ ∧M≤Xt¬$D~D∧∀LqQ J∧**5"∧HJ4≥∃QQ LlzhR¬"HF∪∧t→Q⊂K]Z8R∧#⊗ d jλ~2∧D~8T:∧h→T*¬It∧l 8T∧DM8Xr¬,i~∃,(Q!∀e≤∧
Bbka⊃∪\
4 D|ttλ∃~¬xTu∀*λ(TLtt
$ tIyRrraQ M≤ZIdk∩
E@HK:J%J¬It¬≤-D d lTλd⎇∩ ∀<B
8T<lYj@hP∀ $4≤AQ LDJ(R¬"J!⊂K\xZB¬<z(B∧≤zYe"¬9→d:∧[
D,tHX@hP→Yu4m4
@HH↔8∀t" ZU≥"λxU"∧∀ ∧Jm8Xr¬$λ~B∧∀_qPPL
*$J¬%I¬≤<z(rkλQ!∃≤-K$∧2`Q!∀Lr
IU∧~J!⊂K](X∀"∧→d∧DM8XphP∀
∧⎇∧$
α`H↔:$-%Z)b¬$tλ4|$T ∀r∧ ~4,8Q+PHK8Yd"∧xd∧L4d
4 LAQ$d%8:%+P→zU%≥J$¬\
89∃R¬HHU¬-)_eLLht∧DM8Xr∧dz:Bαj →u*∧~(R¬≥J(∀t$XD⊂hUKQPU≤∀Q∀-D~APU≤∀A∀U∃:D∧d%)
3λh!Q%hH↔8Tt" xb∧Lid∧DM8Xtl,jAPPh `h*:T∃%IA∀d|)~E≤:
HU≥ Q!PT≤yj5$ jJ0hPQ'3[Z ir∧lz(R∧≤yj5$ jJ2¬∧Z)TM%HXB∧ jHU∩¬I ∃~∧→d¬$DT D⎇≤XtαE=)~D, )HR∧4~*5"¬λ_t*HQ!PPh)_c
e1Q"αα∧ %SkUaPRα∧∧∧d|)~E≤;WVHK9itrm(Z$zβWWb∧∀~J4=~λ~$*∧IzphR∧∧α¬∧_xU-Q$ααα
IuαuλwSjpQ$ααα _d<*
IuαuλuUURZ8T=≤≠%EXK:8T*∧_d¬$DZ(R∧M4λ∀t⎇IλU∩¬8Xtl,jD∧d,jD∧|r
I∧M~
λ∀<(Q!∃≤,zZα¬U!Q M≥λ:D⎇α (U∩e;~2eZ+(U∀z$¬∧d⎇t ∀m¬Z(RMhQ!∃≥∧8)u"∧)~@hP_*D∀d:7 L∀Ix4Z∧*J4<=5*4,=9≠"kλQ!∃≤,zZααpQ!∃≥∧:Iuα∧)~Be≥EK4∧MDλ$d|9;PhP→_d*¬Izαu∧uUbb∧Ix$M%8wSkλQ!∩t,J8ReXQ!⊂M<~)b¬\Ix$M%8t¬≥%Xhb∧$_Ib="
yu∀]QQ HLY
¬,txT∧uTX*4:∧h)∃%≤tλ$∀MJ8phP⊃_UE¬Yht*∧*H$d]1Q HLIx$M¬8wSkQ!∃hJ∧∧αβ\YhB∧|d¬d,e8QPRα∧∧¬hK8Yd"∧xa∀L4xT¬$⎇¬j∧:m+%U≤,z9∃PH+Q∪\,hD∧|2 _cλh)_c∩e1Q$L4d
∧ <→hrb¬λ_t--↓Q$L4T
∧ <→hrb¬8Xu-α¬aPUh↔8Tt" xb∧Lf!PPh)_d*∧Ix$M%8u@M≥λ:D⎇α (U∩e)]
PG% EXPUNGE BZERSG
EXPUNGE TOP.PG
SUBTTL SEGMENT TABLES
;;9 FORMAT OF SEGMENT TABLE (<NSEGS> WORDS, ONE FOR EACH SEGMENT)
;;; 4.9 LS 1=LIST STRUCTURE, 0=ATOMIC
;;; 4.8 $FS FREE STORAGE (BIT 4.9 SHOULD BE ON ALSO)
;;; 4.7 FX FIXNUM STORAGE
;;; 4.6 FL FLONUM STORAGE
;;; 4.5 BN BIGNUM HEADER STORAGE
;;; 4.4 SY SYMBOL HEADER STORAGE
;;; 4.3 SA SAR STORAGE (BIT 3.8 SHOULD BE ON ALSO)
;;; 4.2 VC VALUE CELL STORAGE (BIT 4.9 SHOULD BE ONALSO)
;;; 4.1 $PDLNM NUMBER PDL AREA
;;; (ONE OF THE NUMBER TYPE BITS SHOULD BE ON ALSO)
;;; 3.9 RESERVED - AVOID USING (FORMERLY $FLP)
;;; 3.8 $XM EXISTENT (RANDOM) AREA
;;; 3.7 $NXM NONEXISTENT (RANDOM) AREA
;;; 3.6 PUR PURE SPACE (ONE OF BITS 4.8-4.5 OR 3.8 SHOULD BE MN)
;;; 3.5 HNK HUNK OF ONE KIND OR ANOTHER (BIT 4.9 ON ALSO)
;;; 3.4 DB DOUBLE-PRECISION FLONUMS ;THESE ARE
;;; 3.3 CX COMPLEX NUMBERS ; NOT YET
;;; 3.2 DX DOUBLE-PRECISION COMPLEX NUMBERS ; IMPLEMENTED
;;; 3.1 UNUSED
;;; 2.9-1.1 ADDRESS OF A DATA TYPE, ATOM:
;;; QLIST, QFIXNUM, QFLONUM, QBIGNUM,
;;; QSYMBOL, QRANDOM, QARRAY, QHUNK<N>
;;; NOTE THAT THESE ATOMS OCCUPY CONSECUTIVE MEMORY
;;; LOCATIONS AND THUS NUMERICALLY ENCODE THE PAGE TYPE.
;;; THIS COMMENT SHOULD BE KEPT CONSISTENT WITH THE DEFINITIONS (IN THE
;;; DEFNS FIHE) FOR THA ABORE SYMBOLS, AND WITH LOCATION PSYMTT.
.SEE LS
.SEE PSYMTT
SPCBOT ST
ST: ;SEGMENT TABLE
IFE PAGING, BLOCK NSEGS ;FOR PAGING SYSTEM, CODA IN INIT SETS UP
; THESE TABLES AT RUN TIME.
IFN PAGING,[
IF1, BLOCK NSEGS
IF2,[
STDISP: EXPUNGE STDISP ;FOR .SEE
$ST ZER,$XM ;"ZERO" (LOW IMPURE) SEGMENTS
IFN LOBITSG, $ST BIT,$XM ;BIT BLOCKS
$ST ST,$XM ;SEGMENT TABLES
$ST SYS,$XM+PUR ;SYSTEM CODE
$ST SAR,SA ;SARS (ARRAY POINTERS)
$ST VC,LS+VC ;VALUE CELLS
$ST XVC,$NXM ;RESERVED FOR EXTRA VALUE CELLS
$ST IS2,$XM ;IMPURE SYMBOL BLOCKS
$ST SYM,SY ;SYMBOL HEADERS
$ST XXA,$XM ;SLACK SEGMENTS (IMPURE!)
$ST XXZ,$NXM ;SLACK SEGMENTS (INITIALLY NXM)
$ST SY2,$XM+PUR ;PURE SYMBOL BLOCKS
$ST PFX,FX+PUR ;PURE FIXNUMS
$ST PFS,LS+$FS+PUR ;PURE FREE STORAGE (LIST)
$ST PFL,FL+PUR ;PURE FLONUMS
$ST XXP,$XM+PUR ;SLACK PURE SEGMENT (FOOEY!)
$ST IFS,LS+$FS ;IMPURE FREE STORAGE (LIST)
$ST IFX,FX ;IMPURE FIXNUMS
$ST IFL,FL ;IMPURE FLONUMS
IFN BIGNUM, $ST BN,BN ;BIGNUMS
$ST XXB,$XM ;SLACK SEGMENTS (IMPURE!)
IFE LOBITSG, $ST BIT,$XM ;BIT BLOCKS
$ST BPS,$XM ;BINARY PROGRAM SPACE
$ST NXM,$NXM ;(INITIALLY) NON-EXISTENT MEMORY
$ST FXP,FX+$PDLNM ;FIXNUM PDL
$ST XFXP,$NXM ;FOR FXP EXPANSION
$ST FLP,FL+$PDLNM ;FLONUM PDL
$ST XFLP,$NXM ;FOR FLP EXPANSION
$ST P,$XM ;REGULAR PDL
$ST XP,$NXM ;FOR P EXPANSION
$ST SP,$XM ;SPECIAL PDL
$ST XSP,$NXM ;FOR SP EXPANSION
$ST SCR,$NXM ;SCRATCH SEGMENTS
.HKILL ST.ZER
IFN ST+NSEGS-., WARN \.-ST,[=P∂%∨9∞A' ≥≠ ≥(↓)β¬→∀A→ ≥≥)⊂@QM⊃∨+→⊂A¬
Au9≥' ≥&Y6St~∀∪:$w ≥λ↓∪ d~(@@@At∩∩w 9λA∪
8A!β∂%≥∞~∀4∀~∀~(~∀~∀4∀vvv↓)⊃
A→∨%≠βPA∨ AQ⊃
A∂¬%¬β∂∀Aπ∨→1 π)∨HA' ∂5 ≥(AQβ¬→
↓∪&A%¬)⊃ $↓⊃β∪%dXA'∪9π
~∀lvvA)!
A'∪i &Aβ9λA!∨M∪)∪∨9&A∨ ↓β→_A→∪ → LA∪≤A∃βπ⊂A]∨%λA¬%
A ∃! ≥ ∃≥(A∨8A)⊃
4∀vvv↓' ∂≠∃≥(A'%5
\AQ⊃
A→=.A∨%⊃ $@xHdZy'∃∂→∨∞4j||A ∪)&A= A β
⊂A ≥Q%2Aπ=≥)β∪8~∀vvlA)⊃
↓⊃∪∂⊂↓¬∪)&↓∨ A)!
Aβ ⊃% '&↓∨ A)!
A¬→=π⊗A∨_A¬∪)LA)≡A
A+'∃λA∪≤↓≠β%↔%≥∞~∀lvvA)!β(A'∃∂≠ ≥P\@Q≥=)
A)!β(A)!
A∨≠%)) λ↓→∨.[=% $↓¬∪)&↓∨ A)!∪&Aβ⊃ % 'LAβ%
4∀vvv↓5 %≡↓β≥3/¬2\RAQ⊃ '
↓β $A ∪)&A¬%
A∪8A)⊃∪LA')%¬≥∂
AI∪∂⊃(5β ∃+M) λAA∨'∪)%∨≤~∀lvvA
=$A)⊃∀Aπ∨≥Y ≥∪ 9π
A∨_A)⊃
↓∂π≠βI⊗A%∨U)∪≥
Q"],8R\A≥=(Aβ→0A' ∂5 ≥)&↓⊃β-
4∀vvv↓¬∪(A →∨π↔LvA)⊃='
A/!∪π⊂A⊃≡A≥∨PA⊃β-∀AαA¬%(A¬→=π⊗A⊃¬-
A5∃%≡A∪8A)⊃∪LA
∪ 1λ\~∀lvvA)<A)⊃
↓→
(↓∨ A)!∪&A¬%(A¬→=π⊗Aβ⊃ % 'LA
∪ 1λA∪&↓αA
∪∃→λA∨_@xdd5' ∂→=∞|A¬%)&v~(vvvAQ⊃∪&A
∨≥)β%≥&A)!
A≥+5¬ $A= A)⊃∀A≥ 1PA' ∂5 ≥(A%≤A)⊃∀A)β¬1
A∨ ↓)⊃
AMβ≠
AQ3!
\4∀vvvQ≥∨(↓β→_AM ∂≠ 9)&AβI
A→∪9↔ λA%≤A)⊃%&A/βdvA)⊃='
A'∃∂≠ ≥Q&A/⊃%π⊂AβI
A≥∨P~∀vvlA→∪≥- λA)<Aβ≥∨Q⊃ $A=≥
A⊃¬-
A)!∪&A
% →λAi %≡\$A)⊃
↓⊃∪∂⊂5∨% HA¬∪(Q¬∪(h\rR4∀vvv↓∪&A∨9
A∪
_A∂π≠¬%⊗A'!∨+→λ↓≠β%⊗Q! %!β!&A9∨(A/%)⊂Aα↓¬∪(A →∨π⊗$A)⊃
↓π∨≥)∃≥)&~(vvvA= A)⊃∀A' ∂5 ≥(\↓)⊃
A ∪(@dHA¬∪(↓!∨'∪Q∪∨≥&↓)≡A)!
A→ →(A∨ ↓)⊃
A!∪∂⊂[=% $4∀vvv↓¬∪(A= A)⊃∀A¬∪(↓¬→∨π,Aβ I '&A→∪ →λ↓∪&A∨9
A∪
_A∂π≠¬%⊗A'!∨+→λ↓≠β%⊗↓
%∨~↓)⊃
~(vvvA
$A∨_Aβ≤A=¬∃ πPA∪≤AQ⊃
A'∃∂≠ ≥PvA)⊃%&A¬∪PA∪&A5 β≥∪9∂
+_↓∨≥→2↓∪ A¬%(@h\d~∀vvlA∪&A=≥
\AQ⊃
A¬%(A)≡↓)⊃
AI∪∂⊃(↓∨ A)!
Aπ HA¬∪(↓∪&A∨9
A∪
_A∂π≠¬%⊗A'!∨+→λ↓β→'≡4∀vvv↓≠β%⊗↓
%∨~↓)⊃
A
β$A∨_Aβ≤A=¬∃ πPA∪≤AQ⊃
A'∃∂≠ ≥PvA)⊃%&A¬∪PA∪&A5 β≥∪9∂
+_↓∨≥→24∀vvv↓∪ A)!
Aπ HA¬∪(↓∪&A∨9
\@AQ⊃ '
↓)⊃% ∀A¬∪)LA≠+'PA¬
A%≤A)⊃∃'
A aβπ(AA∨'∪)%∨≥&X4∀vvv↓β∂β∪8A
∨$↓)⊃
A
∨≥- 9∪ ≥π∀A∨ A≥π≠β%,@Q"]X\R\AQ⊃
A∨Q⊃ $A ∪)&A%≤A β
⊂A/∨Iλ~∀vlvAβ%∀Aβ%%¬≥∂ λ↓β&A)<A+'
↓+ A
I
A¬%)&A
I∨~A)!
A→ →(A ≥⊂A∨ AQ⊃
A/=%λXAAβπ↔ ⊂~∀vvlA∪≤A¬%∨+≥⊂A)⊃
↓)⊃% ∀A¬∪)LAβ→%∃β 2A⊃ 'π%%¬ λ\↓)⊃ '∀A¬∪)LA∪≥ %πβ)
↓/⊃ )! $~∀lvvA∨HA≥∨(↓)⊃
AM ∂≠ 9(Aπ∨9)β∪≥LA-β→U
Aπ 1→&XAM3≠¬∨1&XA∨HA'β%L\~∀~(~∃∂π ≠%⊗zth```@`∩∩wQ⊃ '
↓β%
A¬→_A→∃
(A⊃¬→ A
1β∂&~)∂π¬π⊃$zzc|xddZq' ∂→=∞Zj|4b|~∃≥π¬πβHz{∂π π %>4b~∀~)∂π∧ztbXXjHjdjd$∩∩w
=$A¬∪PA)3!∃∨+(A5∨
~)554zth```@`~∃∂
¬
∨≡tz`~∃%%!&A9β~Y017-εWM3~W'¬$W⊃≥,A:~∃i54z{i55>ZD~∃∪
8A554→∂π¬π⊃$XA5i4z{5i5>Zd4∃∂π∧¬≥β~zu554~)∪
'
↓0XVX↓∂π¬
=≡z{∂
¬
∨∨q554~)) %≠%≤~∀~)∪
∞A≥π¬⊃≥,[∂π¬
β$XA]β%≤Am∂π≠βI⊗A/∪1_A→∨M
A∨≤↓⊃+≥↔M:~∀~(~∀~∀4∀~∃∂
'(t∩$∩∩w∂ A' ∂5 ≥(AQβ¬→
4∀@@@↓∪
AAβ∂∪≥≤XA¬→=π⊗A≥M ∂&∩m
∨$AAβ∂∪≥≤A'3'Q ~X~(∩∩∩∩lA)⊃
↓∂π'(↓)β¬→∀A∪&AM (A+@Aβ(AI+≤A)%≠
A¬dA∪≥∪P\~∀@@A∪
8A!β∂%≥∞Y64∀∪∪ DXA¬→=π⊗A≥M ∂&~(∪∪ d16~∀∪ )∧\zu¬)¬→-&∩∩w1∨πβ)%∨≤Aπ=+≥) HA
∨$↓β''∪≥≥∪≥∞↓↓∪(A →∨π↔L~∀∩∩⊃∂π'(↓5 $X0X`~∀%∪
≤A1∨¬∪)M∞X@I≥π'(A ∪(HX0`~∀∩$I∂π'PA'(X0X`~∀$∩I∂πM(A'3LXXX`4∀∩∩I≥π'(AMβ$Y_0Y∂π¬5%⊗W∂
¬'β$4∀∩∩I≥π'(AYεXXY≥π¬≠%,W∂π¬Yε~∀∩$I∂π'PA1-ε0XX`~(∩∩I∂
'(A∪LdY_X0`~∀∩$I∂π'PA'3~1_XY∂
¬≠%⊗-∂π¬'e~~∀∩$I∂π'PA11α1_XX`4∀∩∩I≥π'(Aa14XX0`~∀∩$I∂π'PA'2d0XX`~(∩∩I∂
'(A!→0XXX@~∀∩∩⊃∂π'(↓!
&X0X`~∀$∩I∂πM(A!
0XXX`4∀∩∩I≥π'(Aa1 XX0`~∀∩$I∂π'PA∪
&1_Y∧Y≥π¬≠%,W∂π¬
$W∂
¬πβ$4∀∩∩I≥π'(A%
0Y_1∧Y∂π ≠%⊗~(∩∩I∂
'(A∪→_Y_YλY∂π¬5%⊗~∀%∪
≤A ∪∂≥+4X@I∂
'(A¬8Y_Y∧1∂π¬≠I⊗W∂π π $~(∪→11 '∞z{111β'≤~∀∩∩⊃∂π'(DA≥11 '∞Y1a∧Y_X0`~∀∪%
A→=¬∪)'≤X@I∂
'(A¬%(XXX@~∀∩∩⊃∂π'(↓¬!&X0X`~∀$∩I∂πM(A≥1,,,0
$GCST FXP,,,0
$GCST XFXP,,,0
$GCST FLP,,,0
$GCST XFLP,,,0
$GCST P,,,0
$GCST XP,,,0
$GCST SP,,,0
$GCST XSP,,,0
$GCST SCR,,,0
.HKILL GS.ZER
IFN GCST+NSEGS-., WARN \.-GCST,[=WRONG GC SEGMENT TABLE LENGTH (SHOULD BE ]\NSEGS,[)]
] ;END IF2
] ;END OF IFN PAGING
PAGEUP
SPCTOP ST,,[SEGMENT TABLE]
IFN PAGING, SPCBOT SYS
10$ $HISEG
10$ HILOC==. ;ORIGIN OF HIGH SEGMENT
SA$ PSGNAM: 0 ;THESE LOCATIONS FOR SAIL HISEG VALIDATION
SA$ PSGDEV: 0
SA$ PSGEXT: 0
SA$ PSGPPN: 0
SUBTTL BEGINNING OF PURE LISP SYSTEM CODE
PGBOT ERR
;;; THESE CONSTANTS ARE BUILT INTO THE COMPILER.
;;; THEY MUST BE DEFINED HERE FOR THE BENEFIT OF THE PUSHN MACRO.
.SEE PUSHN
NNPUSH==:20 .SEE NPUSH
N0PUSH==:10 .SEE 0PUSH
N0.0PUSH==:10 .SEE 0.0PUSH
BPURPG==:. ;BEGINNING OF PURE PAGES FOR INSERT FILE PAGE AND PURIFY
$$$NIL: 777300,,VNIL ;SYMBOL BLOCK FOR NIL
0,,$$NIL ;ALWAYS KEEP ON FIRST PURE SYSTEM PAGE
$INSRT ERROR ;ERROR MSGS AND HANDLERS
;;; ERROR FILE HAS DEFINITION FOR BEGFUN
PGTOP ERR,[ERROR HANDLERS AND MESSAGES]
PGBOT TOP
;;; LISPGO HAS BAEN MOVED SO IT WILL STAY IN CORE WHEN PURE PAGES ARE FLUSHED
;;; AT SUSPEND TIME AS CONTROLLED BY THE SUSFLS FLAG.
αSUBTTL @ASIC TOP LEVEL LOOP
¬
;;; (DEFUN STANDARD-TOP-LEVAL ()
;;; (PROG (↑Q ↑W ↑R ERALHOOK BASE IBASE ...)
;;; ERROR ;ERRORS, UNCAUGHT THROWS, ETC. COME HERE
;;; ↑G ;↑G QUITS COME HERE
;;; (RESET-BOUND-VARIABLES-AND-RESTORE-PDLS)
;;; (SETQ ↑Q NIL)
;;; (SETQ ↑W NIL)
;;9 (SETQ EVALHOOK NIL)¬
;9; (NOINTERRUPT NIL)
;;9 ↓(DO-DELAYED-TTY-AND-ALARMCLOCK-ILTERRUPTS)
;;; +RECALL THAT ERRORS DO (SETQ // ERRLIST)
;;; (MAPC (FUNCTION EVAL) '/)
;;; (OR (TOP-LEVEL-LINMODE) (TERPRI))
3+; (DO ((@RT '* *))
9;; (NIL) ;DO FOREVER (UNTIL ERROR OR ↑G QUIT)
;9; (SETQ " (COND ((SDATUS TOPLEVEL!
9;; (EVAL (STATUS TOPLEVEL)))
;;; ((PROG ()
;;; (READ-EVAL-*-PRINT PRT) ;print
;;; (READ-EVAL-PRINT-*) ;terpri
;;; A (SETQ TEM (*-READ-EVAL-PRINT)) ;read
;;; (AND (EQ TEM <INTERNAL-EOF-MARKER>)
;;; (PROG2 (TERPRI) (GO A)))
;;; (RETURN (READ-*-EVAL-PRINT TEM)))))) ;eval
;;; )))
LSPBET: PUSHJ FXP,ERRPOP
MOVE P,C2 ;REPUBN TO TOP LEVEL BY ERR, THROW, AND ERRORS
LSPRT12 JSP T,TLVRSS ;RETUBN TO TOP BY ZG
JSP A,ERINIT
SETZ A, ;NEED A NIL IN A FOR CHECKU
PUSHJ P,CHACKU ;CHECK FOR DELAYED "REAL TIME" INTS
MOVEI A,QOEVAL
SKIPE B,VIQUOTIENT ;SHADES OF ERRLIST!!!
CALLF 2,QMAPC
HACENT: PUSH P,FLP .SEE PDLCHK
PUSH P,FXP
PUSH P,SP
PUSH P,LISP1 ;ENTRY FROM LIHAC
HRRZ F,VINFILE ;ONLY PRINT FIRST ASTERISK IF NO INIT FILE
AOSN TOPAST ;IS THIS THE FIRST TIME?
CAIE F,INIIFA
SKIPA ;NOT (INIT-FILE AND FIRST-TIME)
JRST LISP2B
PUSH P,[Q.]
JSP F,LINMDP
PUSHJ P,ITERPRI
JRST LISP2 ;KLUDGE SO AS NOT TO MUNG *
LISP1: PUSH P,LISP1 ;******* BASIC TOP LEVEL LOOP *******
HRRZM A,V. ;THE SYMBOL * GETS AS ITS VALUE THE
PUSH P,A
LISP2: JSP T,TLVRSS ; RESULT OF THE LAST TOP-LEVEL EVAL
POP P,B
SKIPN A,TLF
JRST LISP2A
HRRZ TT,-3(P)
HRRZ D,-2(P)
HRRZ R,-1(P)
PUSHJ P,PDLCHK ;CHECK PDL LEVELS FOR ERRORS
JRST EVAL
LISP2A: MOVEI A,(B)
PUSHJ P,TLPRINT ;PRINT THE LAST OUTPUT FORM
HRRZ TT,-3(P)
HRRZ D,-2(P)
HRRZ R,-1(P)
PUSHJ P,PDLCHK ;CHECK PDL LEVELS FOR ERRORS
PUSHJ P,TLTERPRI ;OUTPUT A TERPRI
LISP2B: PUSHJ P,TLREAD ;READ AN INPUT FORM
JRST TLEVAL ;EVALUATE IT, RETURNING TO LISP1 IF NO EOF
SETZ AR1,
PUSHJ P,TERP1
JRST LISP2B ; LOOP BACK AFTER EOF-PROCESSED EXIT
;;; (DEFUN STANDARD-IFILE ()
;;; (COND ((OR (NULL ↑Q) (EQ INFILE 'T)) TYI)
;;; ('T INFILE)))
STDIFL: HRRZ A,VINFILE
SKIPE TAPRED
CAIN A,TRUTH
HRRZ A,V%TYI
POPJ P,
;;; (DEFUN READ-EVAL-PRINT-* () ;TOP-LEVEL-TERPRI
;;; (AND READ-EVAL-PRINT-*
;;; (FUNCALL READ-EVAL-PRINT-*))
;;; ((LAMBDA (IFILE)
;;; (AND (TTYP IFILE)
;;; (TOP-LEVEL-TERPRI-X (STATUS LINMODE IFILE)
;;; (STATUS TTYCONS IFILE))))
;;; (STANDARD-IFILE)))
;;;
;;; (DEFUN TOP-LEVEL-TERPRI-X (LM OFILE)
;;; (AND OFILE
;;; (COND ((EQ OFILE TYO)
;;; (TERPRI (CONS T (AND ↑R OUTFILES))))
;;; (T (OR LM ↑W (TERPRI OFILE))))))
TLTERPRI:
SKIPE B,VTLTERPRI ;CHECK FOR USER'S INTERCEPT FUNCTION
CALLF 0,(B)
PUSHJ P,STDIFL ;GET STANDARD INPUT FILE
MOVE C,A
JSP F,STBIDP ;IF INPUT FILE IS BI-DIRECTIONAL
POPJ P, ; THEN WE WANT TO TERPRI IT
MOVEI TT,F.MODE ;HAS LEFT INPUT'S TTYCONS IN C
MOVE F,@TTSAR(A)
;TOP-LEVEL-TERPRI-X; TTYCONS IN C, F.MODE IN F,
TLTERX: CAME C,V%TYO
JRST TLTER1
SKIPE AR1,TAPWRT ;IF SAME AS TYO, TERPRI TO
HRRZ AR1,VOUTFILES ; STANDARD OUTPUT FILES
JRST TERP1
TLTER1: TLNN F,FBT.LN ;IF INPUT FILE NOT IN LINMODE,
SKIPE TTYOFF ; AND ↑W IS NOT SET,
POPJ P, ; TERPRI TO JUST THE TTYCONS FILE
TLO AR1,-1
JRST TERP1
;;; (DEFUN *-READ-EVAL-PRINT () ;TOP-LEVEL-READ
;;; (AND *-READ-EVAL-PRINT
3;; (FUNCALL *-READ-EVAL-PRINT))
;;; (DO ((EOF (LIST 'TLRED1)) (IFILE) (FORM))
;;; (NIL) ;DO UNTIL RETURN
;;; (SETQ IFILE (STANDARD-IFILE IFILE))
;;; (SETQ FORM(COND (READ (FUNCALL READ EOF))
;;; ('T (READ EOF))))
;;; (COND ((NOT (EQ FORM EOF))
;;; (AND (NELL READ)¬
;;; (ATOI FORM)
;;; (IS-A-SPACE (TYIPEEK))
;;; (TYI))
;;9 (RETURN FORM)))
;;; (COND ((TTYP IFILE)
;;; (TOP-LEVEL-TERPRI-X () (STATUS TTYCONS IFILE)))
;;; ('T (RETURN <INTERNAL-EOF-MARKER>)))))
$TLREAD: PUSHJ P,TLREAD
POPJ P,
SETZ AR1,
PUSHJ P,TERP1
JRST $TLREAD
TLREAD: SKIPE B,V$TLREAD ;CHECK FOR USER'S INTERCEPT FUNCTION,
CALLF 0,(B) ; AND RUN IT.
PUSHJ P,STDIFL ;GET STANDARD INPUT FILE AS OF
PUSH P,A ; *BEFORE* THE READ, AND SAVE IT
PUSHJ P,[PUSH P,(P) ;ARGUMENT FOR RANDOM EOF VALUE
MOVNI T,1 ;READ THE FORM (POSSIBLY USING USER'S READ)
SKIPE VOREAD ; AND POSSIBLY POPPING INSTACK INTO INFILE
JCALLF 16,@VOREAD
JRST OREAD]
TLRED1: POP P,C
CAIE A,TLRED1
JRST TLREDF
JSP F,STBIDP ;GET BI-DIRECTIONAL ASSOCIATE, IF IT EXISTS,
JRST POPJ1 ; OF STREAM IN B INTO AR1
SETZ F, ;EOF ON TTY MEANS OVER-RUBOUT, SO
PUSHJ P,TLTERX ; TERPRI ON ASSOCIATED OUTPUT TTY
JRST TLREAD ; AND TRY AGAIN
TLREDF: SKOTT A,LS ;SPCFLS - FLUSH A <SPACE> TERMINATING AN ATOM
SKIPE VOREAD
POPJ P, ;NORMAL EXIT - NO EOF, NO SKIP
PUSH P,A
MOVEI T,0 ;PEEL OFF A SPACE, IF THAT
PUSHJ P,TYIPEEK+1 ;WAS WHAT TERMINATED THE ATOM
MOVE T,VREADTABLE
MOVE TT,@TTSAR(T)
MOVEI T,0
TLNE TT,100000 ;WORTHLESS CHAR, OR SPACE ETC.
PUSHJ P,%TYI
JRST POPAJ
;;; (DEFUN READ-*-EVAL-PRINT (FORM) ;TOP-LEVEL-EVAL
;;; (AND READ-*-EVAL-PRINT
;;; (FUNCALL READ-*-EVAL-PRINT FORM))
;;; (SETQ - FORM)
;;; ((LAMBDA (+)
;;; (PROG2 NIL
;;; (EVAL +)
;;; (AND (OR (CAR NIL) (CDR NIL))
;;; (ERROR '|NIL CLOBBERED|
;;; (PROG2 NIL
;;; (CONS (CAR NIL) (CDR NIL))
;;; (RPLACA NIL NIL)
;;; (RPLACD NIL NIL))
;;; 'FAIL-ACT))))
;;; (PROG2 NIL + (SETQ + (COND ((EQ - '+) +) ('T -))))))
TLEVAL: SKIPE B,VTLEVAL ;CHECK FOR USER'S INTERCEPT FUNCTION
CALLF 1,(B)
MOVEM A,VIDIFFERENCE ;THE SYMBOL - GETS THE TYPED-IN
CAIN A,QIPLUS
SKIPA B,VIPLUS
MOVEI B,(A) ; EXPRESSION AS ITS VALUE AND KEEPS IT
EXCH B,VIPLUS ;THE SYMBOL + GETS THE THE TYPED-IN
JSP T,SPECBIND ; EXPRESSION AS ITS VALUE, BUT NOT
0 B,VIPLUS ; UNTIL AFTER IT HAS BEEN EVALUATED.
CEVAL: PUSHJ P,EVAL ;SPECBINDING IT ENSURES THAT IT WILL
JUMPE UNBIND ; GET THIS VALUE IN SPITE OF ERRORS.
PUSH P,CUNBIND
NILBAD: PUSH P,A ;FOO! WELL, ERROR HANDLING SAVES
PUSH P,CPOPAJ ;ALL ACS IN CASE YOU WANT TO CONTINUE
MOVS A,NIL
CSETZ: SETZ NIL, ;NIL=0! CAN USE THIS AS A CONSTANT WORD
PUSHJ P,ACONS
%FAC [SIXBIT \NIL CLOBBERED!\]
;;; PUSHJ HERE WITH PROPER VALUES FOR THE RIGHT HALVES
;;; OF <FLP, FXP, SP> IN <TT, D, R>. WILL ERROR OUT
;;; IF THEY DON'T MATCH UP. USED FOR TRAPPING GROSS
;;; ERRORS IN THE SYSTEM.
PDLCHK: SETZ T,
CAIE TT,(FLP)
MOVEI T,QFLPDL
CAIE D,(FXP)
MOVEI T,QFXPDL
CAIE R,(SP)
MOVEI T,QSPECPDL
JUMPE T,CPOPJ ;EVERYBODY HAPPY?
PDLCRP: MOVEI A,(T) ;NO, PDL CRAP-OUT
LER3 [SIXBIT \OUT OF PHASE (SYSTEM ERROR)!\]
;;; (DEFUN TOP-LEVEL-LINMODE ()
;;; ((LAMBDA (FL)
;;; (COND ((AND (TTYP FL) (STATUS LINMODE FL))
;;; FL)))
;;; (STANDARD-IFILE INFILE)))
;;; SKIP IF INFILE IS IN LINE MODE.
;;; ALSO LEAVE OUTFILES IN AR1 AND READTABLE IN AR2A.
;;; FURTHERMORE LEAVE INPUT FILE IN C (SEE TLPRINT).
;;; ALSO LEAVE TTSAR OF INPUT FILE IN T.
LINMDP: JSP T,GTRDTB
HRRZ C,VINFILE
SKIPE TAPRED
CAIN C,TRUTH
HRRZ C,V%TYI
SKIPE AR1,TAPWRT
HRRZ AR1,VOUTFILES
SFA$ HRLZI TT,AS.SFA ;SFAS ARE NEVER IN LINE MODE
SFA$ TDNE TT,ASAR(C)
SFA$ JRST (F) ;RETURN NON-LINEMODE
XCTPRO
MOVE T,TTSAR(C)
MOVE TT,F.MODE(T)
NOPRO
TLNE T,TTS.TY
TLNN TT,FBT.LN ;ONLY A TTY CAN HAVE LINMODE SET
JRST (F) ;TYPICALLY RETURN TO AN ITERPRI
JRST 1(F) ; OR SKIP OVER IT
;;; (DEFUN READ-EVAL-*-PRINT (OBJ) ;TOP-LEVEL-PRINT
;;; (AND READ-EVAL-*-PRINT
;;; (FUNCALL READ-EVAL-*-PRINT OBJ))
;;; ((LAMBDA (FL)
;;; (COND ((OR (NULL FL) (NOT (EQ (STATUS TTYCONS FL) TYO)))
;;; (TERPRI IFILE)))
;;; (COND (PRIN1 (FUNCALL PRIN1 OBJ)) ('T (PRIJ1 OBJ)))
;;; (TYO 32.)) ;<SPACE>
;;; (TOP-LEVEL-LINMODE)))
TLPRINT:
SKIPE C,VTLPRINT ;CHECK FOR USER'S INTERCEPT FUNCTION
CALLF 1,(C)
PUSH P,A ;TOP-LEVEL PRINT
JSP F,LINMDP ;LEAVES INPUT FILE IN C, VOUTFILES in AR1
JRST TLPR1
JSP F,STBIDP ;BI-DIRECTIONAL?
JRST TLPR1 ;NO, SO GO AHEAD AND TERPRI
AAME C(V%TYO ;IF ASSOCIATED CHANNEL IS TYO, THEN DON'T
; OUTPUT THE <CR> SINCE ECHOIJG WILD DO
TLPR1: PUSHJ P,ITERPRI
TLPR1A: MOVE A,(P)
PUSHJ P,IPRIN1
MOVEI A,40
PUSHJ P,TYO
JRST POPAJ
IPRIN1: SKIPN V%PR1
JRST PRIN1
JCALLF 1,@V%PR1
;; FOR A "BI-DIRECTIONAL" STREAM, GET THE "ASSOCIATE" STREAM INTO C
;; FOR TTYS, THIS IS JUST (STATUS TTYCONS)
STBIDP: HRLZI TT,AS.SFA
TDNE TT,ASAR(C) ;ENTER WITH STREAM IN C
JRST [ MOVEI TT,SR.CNS ;IF SFA, THEN GET THE TTYCONS SLOT
HLRZ C,@TTSAR(C)
JRST STBD1 ]
MOVE T,TTSAR(C) ;PICK UP THE TTSAR
TLNN T,TTS.TY
JRST (F) ;PLAIN EXIT, NO SKIP, FOR NON-BI
MOVEI TT,FT.CNS
HRRZ C,@T ;PICK UP FT.CNS FROM TTY FILE ARRAY
STBD1: JUMPN C,1(F) ; AND EXIT BY SKIPPING 1, IF TTYCONS EXISTS
JRST (F)
;;; TOP LEVEL VARIABLE SETTINGS
TLVRSS: MOVE A,[PNBUF,,PNBUF+1]
SETZM PNBUF
BLT A,PNBUF+LPNBUF-1
TLVRS1: PUSH P,EOFRTN
MOVE A,[ERRTN,,ERRTN+1]
SETZM ERRTN
BLT A,ERRTN+LEP1-1
SETOM ERRSW
POP P,EOFRTN
SETZB NIL,PANICP
SETZB A,PSYMF
SETZB B,EXPL5
SETZB C,PA3
SETZB AR1,RDLARG
SETZB AR2A,QF1SB
SETZM ARGLOC
SETZM ARGNUM
↓JRST (T)
IFN D10,[
SIXJBN: PJOB TT,
IDIVI TT,100.
↓IDIVI D,10.
LSH TT,14
LSH D,6
ADDA TT,(D)
ADDI TT,202020(R)
HRLI TT,(SIXBIT /LSP/)
MOVSM TT,D10NAM ;SAVE ###LSP AS TEMP FILE NAME
POPJ P,
] ;END OF IFN D10
SUBTTL INITIALIZATION ON ↑G QUIT AND ERRORS
;;; ERINIT RESETS PDL POINTERS, THEN FALLS INTO ERINI0.
;;; ERINI0 RESETS VARIOUS VARIABLES AND PERFORMS CLEANUP.
ERINIT:
;DISABLE INTERRUPT SYSTEM
10$ SA% MOVE P,C2
10$ SA% MOVE FXP,FXC2
PIPAUSE ;DISABLE ALL INTERRUPTS
ERINIX: ;ENTER HERE IF INTERRUPTS ALREADY DISABLED
IFE PAGING*<1-SAIL>,[
MOVE P,C2 ;SET UP PDL POINTERS
MOVE FXP,FXC2
MOVE FLP,FLC2
MOVE SP,SC2
] ;END OF IFE PAGING*<1-SAIL>
IFN PAGING,[
HRRZ T,LISPSW
CAIE T,LISP
JRST ERINI9
IFE SAIL,[
MOVE T,[$NXM,,QRANDOM]
MOVE TT,PDLFL2 ;CONTAINS <- # OF PDL SEGS,,# OF 1ST PDL SEG>
MOVEM T,ST(TT) ;UPDATE SEGMENT TABLE TO REFLECT
AOBJN TT,.-1 ; LOSS OF PDL PAGES
HRRZ T,PDLFL1
ROT T,-4
ADDI T,(T)
ROT T,-1
TLC T,770000
ADD T,[450200,,PURTBL]
SETZ D,
HLRE TT,PDLFL1
ERINI8: TLNN T,730000
TLZ T,770000
IDPB D,T
AOJL TT,ERINI8
IT$ MOVE T,PDLFL1 ;CONTAINS <- # OF PDL PAGES,,# OF 1ST PDL PAGE>
IT$ .CALL PDLFLS ;FLUSH ALL PDL PAGES
IT$ .VALUE
20$ WARN [SHOULD TWENEX FLUSH PDL PAGES??]
10$ WARN [SHOULD TOPS-10 FLUSH PDL PAGES??]
] ;END OF IFE SAIL
ERINI9:
IRP Z,,[P,FLP,FXP,SP]
MOVEI F,Z
MOVE Z,C2-P+Z ;CAUSE ONE PDL PAGE
MOVEI D,1(Z) ; FOR Z TO EXIST
ANDI D,PAGMSK ;BUT FOR SAIL, MAKE ALL EXIST
SA$ MOVE TT,D
JSR PDLSTH .SEE PDLST0
SA$ MOVEI D,PAGSIZ(TT)
SA$ CAMGE D,XPDL-P+Z
SA$ JRST .-4
TERMIN
ERIN8G: MOVE T,[XPDL,,ZPDL]
BLT T,ZSPDL
] ;END OF IFN PAGING
ERINI0: SETZB NIL,TAPRED ;INITIALIZATION AFTER PDL SETUP
SETZM NOQUIT
SETZM REALLY
SETZM FASLP
IFN USELESS, SETZM TYOSW
SETZM INTFLG
SETZM IJTAR
SETZM VEVALHOOK
SETZM GCFXP ;NON-ZERO WOULD MEANINSIDE GC
SETZM BFPRDP
MOVE T,[-LINTPDL,,INTPDL]
MOVEM T,INTPDL
MOVEI T,$DEVICE ;RESTORE READER'S LITTLE MEN
MOVEM T,TYIMAN
MOVEI T,IUNTYI ;INTERNAL UNTYI'ER
MOVEM T,UNTYIMAN
;FALLS THROUGH
;FALLS IN
ERINI2: SKIPL MUNGP ;MAYBE NEED TO UNMUNG SYMBOLS AND SARS
JRST ERINI6
MOVE D,SYSGLK
ERINI5: JUMPE D,ERIN5A
MOVEI F,(D)
LSH F,SEGLOG
HRLI F,-SEGSIZ
LDB D,[SEGBYT$,GCST(D)]
ERIN5C: MOVSI R,1
ANDCAB R,(F) ;UNMUNGS THE SYMBOL HEADER, IF NECESSARY
HLRZS R
HRRZ R,(R) ;GET ADDR OF VALUE CELL
CAIL R,BVCSG
CAIL R,BVCSG+<NXVCSG+1>*SEGSIZ
JRST .+2
JRST ERIN5D
CAIL R,BPURFS
CAIL R,PFSLAST
JRST .+2
JRST ERIN5D
HRRZS (R) ;UNMUNGS THE VALUE CELL, IF STORED IN LIST SPACE
ERIN5D: AOBJN F,ERIN5C
JRST ERINI5
ERIN5A: MOVE F,[SARTOB,,B]
BLT F,LPROGZ
MOVE D,SASGLK
ERIN5B: JUMPE D,ERINI6
MOVEI F,(D)
LSH F,SEGLOG
HRLI F,-SEGSIZ/2
LDB D,[SEGBYT,,GCST(D)]
JRST SATOB1
ERINI6: HRRZS MUNGP
SKIPN MUNGP ;UNMUNG VALUE CELLS (SEE ALIST)
JRST ERIN6A
MOVEI F,BVCSG
SUB F,EFVCS
HRLI F,(F)
HRRI F,BVCSG
HRRZS (F)
AOBJN F,.-1
SETZM MUNGP
ERIN6A: MOVE B,[ERRTN,,ERRTN+1]
SETZM ERRTN
BLT B,UIRTN
SETOM ERRSW
MOVSI B,-NSFC
ERINI3: MOVE C,SFXTBI(B) ;RESTORE CLOBBERED LOCATIONS
MOVEM C,@SFXTBL(B)
AOBJN B,ERINI3
TLZ A,-1
;ENABLE THE INTERRUPT SYSTEM
IFN ITS,[
.SUSET [.SMASK,,IMASK] ;RESTORE INTERRUPT ENABLE MASKS
.SUSET [.SMSK2,,IMASK2]
.SUSET [.SDF1,,R70] ;RESET DEFER WORDS
.SUSET [.SDF2,,R70]
] ;END OF IFN ITS
PIONAGAIN
JRST (A) ;RETURN TO CALLER
SARTOB: ;TURN OFF MARK BITS IN SARS
OFFSET B-.
SATOB1: ANDCAM SATOB7,TTSAR(F)
AOBJP F,ERIN5B
AOJA F,SATOB1
SATOB7:
TTS<GC>,,
LPROGZ==.-1
OFFSET 0
.HKILL SATOB1 SATOB7
PDLFLS: SETZ
SIXBIT \CORBLK\
1000,,0 ;DELETE PAGES...
1000,,-1 ; FROM MYSELF...
SETZ T ; AND HERE'S HOW MANY AND WHERE!
SUBTTL SPECIAL VARIABLE BINDING AND UNBINDING ROUTINES
JFCL ;HISTORICAL LOSS -- EVENTUALLY FLUSH
SPECBIND: MOVEM SP,SPSV ;0 0,FOO MEANS FOO IS ADDR OF SVC TO BE BOUND TO NIL, SAVES D
SPEC1: LDB R,[271500,,(T)] ;0 N,FOO MEANS SVC FOO TO BE BOUND TO CONTENTS OF ACC N
↓JUMPE R,SPEC4
CAILE R,17 ;7←41 M,FOK MEANS BIND FOO TO -M(P)
JRST SPEC3 ;OPHERWISE, IS PDP10 INSTRUCTION, SO EXIT
SPEC2: HRRZ R,(R) ;NOTE WELL! NCOMPLR DEPENDS ON THE FACT
CAML R,NPDLL ; THAT R = DT+2 = NUMVALAC+2
CAMLE R,NPDLH
JRST SPEC4
PUSH FXP,T
MOVEI T,(R)
LSH T,-SEGLOG
SKIPL T,ST(T) ;NMK1 WILL WANT TYPE BITS IN T
TLNN T,$PDLNM ;SKIP IF PDL NUMBER
JRST SPEC5
HRR T,(FXP)
LDB R,[271500,,(T)] ;RECOMPUTE ADDRESS OF FROB
CAIG R,17
JRST SPEC6
TRC R,16000#-1
ADDI R,1(P)
SPEC6: PUSHJ P,ABIND3 ;TEMPORARILY CLOSE THA BIND BLOCK
PUSH P,A
HRRZ A,(R)
PUSHJ P,NMK1
MOVEM A,(R) ;CLOBBER LOC OF FROB WITH NEW NUMBER
CAIN R,A ;GRUMBLE
MOVEM A,(P)
SUB SP,R70+1 ;SO RE-OPEN THE BIND-BLOCK
MOVEI R,(A) ;THEREBY INHIBITING INTERRUPTS
POP P,A
SPEC5: POP FXP,T
IFN D10,[
SPEC4: PUSH FXP,T
MOVEI T,@(T)
CAIN T,PWIOINT
JRST [ POP FXP,T
JRST WIOSPC]
EXCH R,(T)
POP FXP,T
] ;END IFN D10
10% BNDTRAP SPEC4,WIOSPC,T, EXCH R,@(T)
SPEC4A: HRL R,(T)
PUSH SP,R
AOJA T,SPEC1
SPEC3: CAIGE R,16000
JRST SPECX
TRC R,16000#-1 ;RH OF R NOW HAS N
ADDI R,1(P) ;SPECBINDING OFF PDL
JRST SPEC2
ERRPOP: POP FXP,ERRPAD ;POP RETURN ADR OFF FXP
MOVE TT,C2 ;RUN ALL OF THE UNWIND HANDLERS
MOVEM T,ERRPST ;SAVE T
PUSHJ FXP,UNWPRO
MOVE T,ERRPST ;RESTORE SAVED T
PUSH P,ERRPAD ;SAVE ERR RETURN ADR
;ENTRY POINT IF NO UNWIND-PROTECT FUNCTIONS SHOULD BE RUN
ERRPNU: SKIPA TT,ZSC2 ;TOTALLY POP OFF SPECPDL FOR ERRORS
UBD0: TLZA TT,-1 ;POP SPECPDL TO PLACE SPECIFIED IN TT
SETOM (TT) ;ERRPOP MUST SETOM - SEE UBD4
UBD: CAIL TT,(SP) ;RESTORE THE SPDL BY RESTORING VALUES
JRST UNBND2 ; UNTIL (SP) MATCHES (TT)
POP SP,R
HLRZ D,R
TLZ R,-1
CAMGE R ZSC2
JRST UBD3
CAIGR,(SP)
JRST UBD4
SKIPN D
.LOSE ;Somebody screwed the SPECPDD - HELP!!!
BNDTRAP UBD3,UBDP,D, HRRZM R,(D)
UBD1: JRST UBD
UBDP: PUSH FXP,T ;Figure out if WIT@OUT-INTERRUPTS
HRRZI T,(D)
CAIN D,PWIOIJT +WIP@OUT-INTERRUPTS, handle speCially
↓ JRST UB@WIO
POP FHP,T ;Restore state
HRRZMR,(D ;Recause epror will trap thiS time
↓JRST UBD ;Continue if continued
UBDWIO: PUSH P,[WIOUNB] ;Iake sure without-interrupt'er gets called
POP FXP,T
PUSH FLP,R ;With old value to store
MOVSS (FLP) ↓ ;WIOUNB expecTpεASh↓S\AY∃MhAQ¬YL~∀%∃%'(↓+¬λ~(~∀~∃U¬λht%⊃→%4↓λXQ'@R~∀∪)+≠!≤↓λY+¬⊂∩@@@sβ≠∨9∞A∨)! $A)!∪≥∂&0A %%A∨ O&↓' )∨4A≠β↔∃&A)⊃%&A∃+5 ~∧∪A+'⊂A→→ Y($∩w≠ M(A'βY
A(~(∪≠∨-∃∩A(X!$R~∀%!+'⊃(A IβU≥¬≤`$∩w
∨U≥Aα↓
+≥βI∞A¬∪9 ∪≥∞↓↓→∨π,~∀β!= A
→@Y(∩∩l@ZA+M
A'!∃β∪β_↓%∨+ %≥αA <A+≥¬%≥A∪P~∀&U∩NQα,∩⊂4λhP4*Vt∩&*⊃PJB>A¬~A2PhP&6>4*5αR bV:
t!L%nDzJJ&∀b∃αα ~-αRzαNεZ*αε
α%!9αRDJ2-α ∩>VQ¬""&M¬~>6∃∧"εd4U*:
:#↓h&ReQαQ1kλ%nε,r
&:"α⊗:R-∩Mα"-∩∀4(hR&~∃∧!EA2Xh*V:∀r⊃EhL~ε&9¬!1"NαH4(%∧RJNQ¬*:
:#⊂4(&∧zAαNαbRP4PJ6>Z≥→αRPhP&
:%"JεAαbV:
t"A2R"aα"2∃R5αR"a"RQHh(&*∃~QαVt∩:↓DhRumα,r⊃α&4)α⊃Eα`4(∀TJ~9α# A2lhP&BV≤Aα~bαbH$%α↓↓nO∂3∃αIε3?Iβ≤{7Cπ⊗KO?9αB∂π9?!βWO*α~2Aαi5βW≡+⊃βSzβCπO_h($$HI↓↓↓Zβπ9β∂∪∨W7.sQβSzα↑&>,r $4PJ6>Z,IαI2¬:&>&u $%↓α↓n≠?∩β∂?7ε K'O}q1β≠∞≠S?K.!β?W"β?→β&C∃β3}{@4*,r
:⊃ P&∞εLqαQ1E~A$$J↓↓↓n.s⊃β?2β3??␈↓|4(J↓α*J≥!αV:∀!J∧4PJB>A¬~A2R h(&6⎇2NMα% 4(&≤
&9α∩a"RQHH%↓↓βZ'Mβ&C'Mβ&C∃βOε+∂'πbβ∂πO*αB↑&|J:Q|hP%↓αU∩NQα,r
:∩H%↓↓βY↓αg/→1β#∞≠-β' h(&"e∩j5α%!1"R"H4(εU∩NQα,r
:⊃λh*um∧*:⊃αL29α⊃ ↓04(hRV:
t"Ah&¬*N!α5BA2PHI↓↓↓\2&≡V∀)α>V"α&→α<JR">-!6&:$*JJV¬"L4(LBJJjJαQ1"%!$4(L~ε&9¬!2B↑Lz&:PHI↓↓↓]:&R"⎇*Q6&u"⊗JJ-αRM1∧Bε:∩d)αNB,~&ε2eH4(¬∧RJNQ¬*:
↑Lx4(&∧zAα~E↓2P$J↓↓↓n∀*NR>∀)αNR
"∀4(LB2JjhαRQ1E"Q$$J↓↓↓n∀*∞εV≤)α⊗J∀zI1α<J21α%∩εAα$B&Mα$J6∀4PJ*JN"αV:
t!D$%α↓↓n∞|rR&:,)α&→∧~>:RLrV⊗⊂hP4*Vt∩↑&=PJBVNBαA2n<J>V:∃h$%↓α↓n6ε\)αNV∀)α↑&$B>VQlJ:R⊗∃∩VBQ<*Iα≡-"Mα∞ b2⊗⊂hP&B>αα~bAe 4(&¬*N!α4bA2R H%↓↓βZ↑&RBα>2⊃¬2ε2V(h(&*∃~QαVt∩:⊃DhP04)[Ymα
Lr⊃1α r⊃α6 Z∃6Z bV∃6≤*21α∀zVR&t*M9↓h)mmZαBVNDQαA2∀J:⊃↓αα↑&RBαNf6∀z1α&rα¬1α4
2V∃∧J9αε∪ 9↓hQmmmα↓↓↓α-~⊗Mα|r2eα
aαRQZ↓α6V≥!αNε4)αP4SYmmαU~AαR"b6ε.4→↓α↑M"!αεrαεR>lJ
αNLj
>1∧z9αRD)αB∩b↓"↑"L~!α&~αB>B∧*⊃$4SYmm↓α↓↓αεt!αR"*αZε2,)α&9∧⊃9αJ-"VJ:~αε∩∩∀*NMα|1α:⊗:αZε2,)α∞⊗daα&9∧ 84)[Ym↓↓α↓↓"2
"R⊗I∧~J>∞Zα~>I∧∩&:⊃
α>:2JI9↓α-~⊗Mα|r2eα
b 2R"p4(4T∩&:⊃PJN.&∧qαRQdλ4(¬∧RJNQ∧∩&:⊃(h(&"e∩iα¬bB¬$4R↓↓αb≥"BJ<hP&"J∃Qα¬1D $4)α↓α:>¬∩<4(L~ε&9∧ 2NVt∩>V: h(%αU∩NQα∀J:⊃DhR
&:#!h&B-~!αNαa"¬$hP&"Jdiα¬1E~A$4PJ
:∩%∩εAα≥"FBV∩b↑&>∀r⊃2¬bα"JJTiαεI
a"¬$hP&B>∧QαA0hP4*
Lr⊃UhLj>Z⊗Jα¬2ZtJ0$%\
22>:αBVJ∧:%αR∀
AαRzα↑>JZα*VN"4*∞∀J:⊃QPJ*JN"α
&:# $%ndJ.∃α4zIαN-"F&::αP4(hR
&:# h&B-~!αAd~
&:# $%n≤*QαVαα~>I∧~ε2⊃¬"=α6 ZZ 4PJBVNBαA2λhP&BV≤AαA2% 4(εlzR⊗%∧⊃2FVt∩>V: h(&*≥↓αRQdjε.Z_h*B>∧∩)h&∧zAαAd⊂4*∞∧zB
)PJB>BRαA2B⎇α
(4Ph*6ε]2
h&¬*N!α5BA2R H%nN
2∃αJ-"VJ9∧
∩∩HhQ↓↓α≥α⊗∞B∀yα&:%Rε`4Tjε.Z≠↓h&N\JB9α
b~~Z_h(&*∃~Qα6 ZZ
LhP&⊗b≤Aα 2∧2~Z hQ↓↓αD~RBJxh(&"∃∩j5α∩b~~Z_h)↓↓∧r>BJxh*6ε]2
EhLB2Ji∧⊃2↓"αH$%n∧z&*R-⊃αR=¬~f6
|aα"⊗ "⊗IαM→α>9¬~Rε∞Xh*BV∃"JεA∧jε.Z≠I2 0LBJJ5∧ 1" Hh*6ε]2∞ahM~V ααbI]A[λ$%n∧zAαB|J:R⊗∩aαJ⊗%*J9α "∩J⊗≥→α>→¬2ε2V*α∞⊗2`h(&B⎇α)α~E↓0$%Zα&)α
aαε∩%⊃α>→¬~eIα∀b>∞
∧J9αλhP4*&4)αBε<J::K1PTl→:d≠≠!~¬-≤ $¬αd9ye≠λQ!∃≤-IyR∧-Jh44e8↓PPL**5"∧X→54≠⊃Q%hH↔8Td" xb∧LhT¬∧ y→d8h!Q `h*:T∃%IA∃4
)→u-~ xD$∀→IB∧≤yj4-∃1Q hT_ib∧∀_ye,jK1PT≠_9tu≠!_UD≤∧
BeL_xD∃ Q!∀U≥∧
Bd5x9tu_Q!∀-D9∧¬"e__t$∃AQ LU*:B∧ 9ye_h+Q⊂K\YhB∧|d ∀4rλ)∀<uYQPPh$Yd≤|j7 M¬Z9α¬αJAPTt9ye≠P~IER∧∃ESλHQ$αα∧(→5¬∀qQ$ ≤yj3PM99∃∧rλhe_H↔:DDM4 ∃~∧∀λ4|u4 DL\T ∧≤|j1PPM
Z4DR
¬D <1⊃∪\∃ZD¬-≤Z4∧|tK∀∧ ≤:YU,d~Iu∩∧⊃Q Llzj5~∧⊃⊃⊂K]:x∃α∧λ→E4-4 t2∧∃D¬$DYaPRα∧
5∧,:
$z∧→jD ≥↓Q L-λ9α∧
Hλd5_⊃↔4≤|j4¬<DyHR¬<z(B∧5)yR∧λQ$αα¬λ:E¬∀qQ L-λ9α∧
Hhe_h$∧α∧tz
$xh!~∧⎇∧$
α`h!Q$L4dλ$L<jYReXQ!PRα∧λ$ ]
)phT(ydl 7!⊂HK9X∀\*λ∀¬∧⎇9~DM4Tλ$L<jYRαE8→T*∧~4∧∀t9ye~HQ($t≤yj3PM99∃∧rλhd⊂K8)∀<uYT∧≤|j8U⊂h!~¬-≤ $¬αd_x0hP_[∧≤Bλ∃D∧4h!PRα∧ ∧≥%
)phP_[∧≤Bλ∃D44!Q"αα iu¬∀qQ M∧z "¬αAQ%hH↔8Tt" xb∧Lid∧∀LyjThh `h'73Z∧[
∧d|HX2∧
(zTl,jD∧Lrλ∀αE<~Iα∧∀~8Sk ¬eBαTiz∧|LjGU"JAQ#[[4λ∀t"
(U%-)d∧
¬9≠∧∀MD
t⎇∀D ∀r¬JEbα∧9It∀∀Z*2∧ ID∧ ≥5aPPh*9∃Dl→7 LlzhTJ∧%I∀sα6⊗αph!→%≥α
EE≥∧X8$LtAQ Jαε∧∧∩eh(∃≤(Q!∩αβ∧λ"e2iiu∧|→j@hP~8U%TT
4MDY6 hP→Yu4*λ~#
e6FCβ3ε¬Be≤≠ T[∃QQ LE*)tJ¬%J4MDY6⊂HJj8T*¬
%e¬∀1Q M¬Z9∧R¬¬J¬∀LjH⊂HK88∀db
$LuH∀¬$zλ[¬∧dxHT~¬IλR∧
(zTl,jAPPLYzd*¬JEE≤M Y3⊂h!→%∃≥D
Tt∀→h@hPQ*4MDY6∪PL8→∀<*λ∃C #↓↔5$D~4¬≤
~4∧≤|jhU∃" Iu<-$λ4
≤T
Dz¬Z
∧-⊂Q!∃%∀4λ∩c#↓↔4≤|jhU∃"λ9∧
∩
Ir¬≤≠λ$M Q!∃$dhT∧
∪∃Fs;βεεhRjXE##!∀∧L%λ$∧
d~&⊂K\X≠∀∀*
8∃4* ~Bb¬YiD-≥4λ∀e∀X_EJ∧λ~d*¬9≠hP~ u∧R
¬@hPQ'3[Z
H∀\*
9∃D∀~D∧Lr
JBb¬(ZE-∀dλ∀r∧~ItlL4
5Ll)yB∧Ldλ∩ph'73Z∧YX$,$HXB∧∀H→d]~λ9u,uED∧∃-D
E∀ I→d:∧yhU~∧Iyb="aQ#[[4λ∩¬TZ)r¬<z(B∧∀X9tl-4
DD*λ~D|j∧%"∩r∧
4
4Z4∧2pQ!PU≤≠λ∃$k!~4-$yT∧e∧haPPLYzd*∧5J∧t∃↓Q Llzj4J¬EE∧
≤9→∩¬b+E⊂hP→Yu4,T
Be∧h*T0h!~4-%)T¬∧t*Xb[λQ*4MD~F∪PL*YU∧*
JBe∀→jD-∀a↔5∀LjHU∀r
8∃4-4λ`hP~8U%R
E@hP→J4D~
EC0h!_∀$$∀
Bc#↓⊃∪\≤yjd-∃D
4MD)~B¬$tλ∃≤≤→⊃PPL_J∧∩¬EH0HK::DL≤4λ4D
(_5$-*4∧Lr
d∃,aQ LU*:B¬≤≠λ∃#λQ!PS[74∧
¬:J$Ltt ∃~∧→d¬∧t*Xbb¬HZ$lLh~D,"λ+∩∧
jTdbaQ#[[4 D|≤~HR∧MJ4∧,tED∧ tDλ4 dD
$LuHZ$r¬It∧l 8T∧ rλ~D|jaQ hU h$4
G!∀l⎇hT¬"e h%h* d∀4⊗↔ LlzhR∧~JAPPL→HD∩¬JEE h!→%,m d¬%"J d∀4⊗⊃PPM8ZD|j J∧t0Q!∀U∃:D¬∀LjHU∀pQ!PS[74¬$ 8T∧ r
5T-E
(U≥≤→yb∧Ldλ∩b∧→hB∧-
D|$X4∧M" →e$z
d∃,eaPS[74∧
∪(∀¬<LID∧≤|jH∀Lr
I∧*∧9zTu" xb¬,jZ4,"λ9∧
∀_:D-∩
u≤MI→tu~ →b¬∧h*T2pQ'3[Z
$-≤Z*d-~ ~E~∧~(u,lYjBph!Q%∧t(iT[P~
U≤B
¬Dλh!~¬-≤∧
αd≥ z∧ PQ!∃≤-K)R¬∧h*T0h!→T⎇4T
Be] h%,2EJ∧t∃Xe3
hQ!∀∀eD
Be∧h*T2\J d∃,eV⊂hP→Yu4*λ~#
e h%h!→T⎇4Y∀∧
∪(∃De∧h*T2T+~E≥<AQ LE*)tJ¬%J∧t∀iV`HJj8T*¬
%e¬∀1Q LU*:B¬¬)→e$λQ!PU∧h(dk3!→%,m HR∧
&(∩d≥ z∧PK8y∃4*
Zα∧Ld dz∧Yz$*¬)ytj∧→d¬∧t*X`hP→_E∧∩λ∃D
∪⊃⊃∪\,J8R¬≥I_4Z∧9λ∃∀ :HU∩∧→aPPM9y$
∧~&$
d: u∧PQ!PPh!Q hPQ)∀4rλF∪αe1Q#[[4λ4|uhZ%"∧∀
¬∧r →b¬%D
Dz∧→dα∀
IyR∩b ∃d*rλ→b¬~X[¬¬∩ xb∧
$⎇¬)_∃$*λiu∀jd∧¬≤
hZ2∧2aQ hU
d
$W!PTLhT¬≤ →EEXh!~4\M d∧≤mZ↓PPJ *%≥"
∧t
F!PPL J%R¬EJE h!_4 lT
E"e5V∃hh!∀∧≤ _t¬"c⊗↓⊂K]
b=~
y∃$B
$|TX:B∧∀ZJt,,dε∩∧ hDβ Q!∩α∧**5"¬
d
#!⊃∪Z∧ZZ5"∧(T∧-E
(U≥≤XD∧LrλHT~∧iz$hh!→T⎇4T
Be]JEBe∧h*T5hQ!∃≤-K)R¬∧h*T2[⊃⊃∪\tXXB¬$ ~2∧∀X8∃-≤T t2∧9ZR∧∃XqPPLHX4≤mT
B`HRY CONVERTING PPN TO CMU STRING
JRST PPNAT2 ;ON FAILURE, JUST REVERT TO DEC FORMAT
JRST PNBFAT ;ON SUCCESS, CONS UP ATOM FROM STRING
] ;END OF IFE SAIL
PPNAT2: JUMPN TT,.+3
MOVEI A,Q.
POPJ P,
PUSHN P,1
PUSH FXP,TT
TLZ TT,-1
PUSHJ P,PPNAT4 ;CONVERT PROGRAMMER
POP FXP,TT
HLRZS TT
PUSHJ P,PPNAT4 ;CONVERT PROJECT
JRST POPAJ
PPNAT4:
IFE SAIL,[
CAIN TT,-1 ;777777 => OMITTED HALF OF PPN
SKIPA A,[Q.] ;REPLACE IT WITH *
JSP T,FXCONS ;OTHERWISE USE A FIXNUM
↓MOVE B,-1(P)
PUSHJ P,CONS
MOVEM A,-1(P)
POPJ P,
] ;END OF IFE SAIL
IFN SAIL,[
CAIN TT,-1 ;777777 => OMITTED HALF OF PPN
JRST PPNAT9 ;REPLACE IT WITH *
JUMPE TT,PPNAT9 ;? MIGHT AS WELL TREAT 0 AS OMITTED
PPNAT6: TLNE TT,770000 ;LEFT JUSTIFY THE SIXBIT CHARACTERS
JRST PPNAT3 ;GHEN DONE, CREATE AN ATOM AND CONS ONTO LIST
LSH TT,6
JRST PPNAT6
] ;END OF IFN SAIL
SA$ PPNAT9: SKIPA A,[Q.]
PPNAT3:
20% PUSHJ P,SIXATM
20$ PUSHJ P,PNBFAT
PPNAT5: MOVE B,-1(P)
PUSHJ P,CONS
MOVEM A,-1(P)
POPJ P,
] ;END OF IFN D10
SUBTTL CATCH, THRMW, ERRSET, .SET, AND BREAK ROUTANES
;NORMAL CATCH
CATPUS: PUSH P,B ;COMPILED CODA FOR *CATCH ENTERS HERE
MOVEI A,(A) ; COMPLR TURNS "CATCH" TO "*CATCH"
MOVEI T,(A)
LSH T,-SEGLOG
SKIPGE ST(T) ;SEE IF TAG OR TAGLIST
HRLI A,CATSPC\CATLIS
CATPS1: MOVEM A,CATID ;SET UP A CATCH FRAME
JSP T,ERSTP
MOVEM P,CATRTN
JRST (TT)
;CATCH-BARRIER
CATBAR: PUSH P,B ;ADR TO JUMP TO WHEN THROW IS DONE
HRLI A,CATSPC\CATLIS\CATCAB ;FLAG AS CATCH-BARRIER
MOVEM A,CATID ;THIS IS THE CATCH ID
JSP T,ERSTP ;SETUP A NEW CATCH FRAME
MOVEM P,CATRTN
JRST (TT)
;CATCHALL
; UPON ENTRY: TT HAS ADR-1 OF CATCHALL FUN, T HAS ADR AFTER OTHER FUNS
CTCALL: PUSH P,T
AOS TT ;POINT TO FIRST LOCATION OF CATCHALL FUN
HRLI TT,CATSPC\CATALL\CATCOM ;FLAG AS A COMPILED CATCHALL
MOVEM TT,CATID ;THIS IS THE CATCH ID
JSP T,ERSTP ;SETUP A NEW CATCH FRAME
MOVEM P,CATRTN
JRST -1(TT)
;BREAKUP A CATCHALL
THRALL: SETZM (P) ;TURN INTO A NORMAL CATCH
JRST THROW1 ;THEN BREAK UP LIKE A NORMAL THROW
THROW5: SKIPE D,UIRTN ;IF NO USER INTERRUPT FRAME STACKED,
CAIG D,(TT) ; OR IF IT IS BELOW THE CATCH FRAME,
JRST THROW3 ; THEN JUST EXIT THE CATCH FRAME
JSP TT,UIBRK ;OTHERWISE BREAK OUT OF THE INTERRUPT
THROW1: SKIPN TT,CATRTN ;SKIP IF CATCH FRAME BELOW US
JRST THROW4
MOVSI T,CATUWP
TDNE T,(TT) ;UNWIND-PROTECT FRAME?
JRST THRNXT ;YES, SKIP IT COMPLETELY
JUMPE B,THROW5
THROW6: SKIPN T,(TT) ;(CATCH FOO NIL) = (CATCH FOO)
JRST THROW5 ;CATCH ID MATCHES THROW ID
TLNE T,CATSPC ;SPECIAL PROCESSING NEEDED?
JRST THRSPC ;YES, DO SO
CAIN B,(T) ;CATCH ID MATCHES?
JRST THROW5 ;YES
THRNXT: MOVE TT,<-LEP1+1>+<CATRTN-ERRTN>(TT) ;GO BACK ONE CATCH
JUMPN TT,THROW6 ;FALL THROUGH IF NO MORE
THROW4: JUMPE B,LSPRET ;IF TAG IS (), THEN JUST THROW TO
THROW7: EXCH A,B ;TOPLEVEL; OTHERWISE, ERROR
%UGT EMS29
EXCH A,B
JRST THROW1
THROW3: PUSHJ FXP,UNWPRO ;UNWIND PROTECT CHECKER
MOVE P,TT
THRXIT: SETZM PANICP
MOVSI D,-LEP1+1(P)
HRRI D,ERRTN
BLT D,ERRTN+LEP1-1
MOVE C,CATID ;GET CURRENT CATCH ID
SUB P,EPC1
POP P,FXP
POP P,FLP
POP P,TT
POP P,PA3
PUSHJ P,UBD0 ;RESTORE CONDITIONS AND PROCEED
TLNN C,CATALL ;A CATCHALL?
POPJ P, ;NOPE, RETURN THROWN VALUE
EXCH A,B ;TAG AS FIRST ARG, VAL AS SECOND
TLNE C,CATAOM ;CGMPILED?
JRST (C) ;YES, RUN COIPILED CODE¬
AALLF 2,(C) ;ELSE CALD THA USER'S FUNCTIOF
POPJ P, ;RETURN NEW VAL IF THE CATCHALL FUN RETURNS
THRSPC: TLNE T,CATALL ;CATCHALL?
JRST THROW5 ;YES, WE HAVE FOUND A GOOD FRAME TO STOP AT
TLNE T,CATUWP ;UNWIND-PROTECT?
JRST THRNXT ;YES, IGNORE THE FRAME
TLNE T,CATCAB ;CATCH-BARRIER?
JRST THRCAB
TLNN T,CATLIS ;A LIST OF TAGS?
LERR [SIXBIT\SPECIAL CATCH FRAME, BUT NO VALID TYPE BITS EXIST!\]
PUSH P,A
PUSH P,B ;SAVE NEEDED ACS
↓MOVEI A,(B) ;CATCH TAG
MOREI B,(T ;LIST OF TAGS
PUSHB P,MEMQ1 ;CHACK FOR MEMBERSHIP (DGES NOT DESTROY DT)
MOVE T,A ;SAVE THE RESULTS
POP P,B
POP P,A
JUMPE T,THRNXT ;UPWARD TO NEXT CATCH FRAME
JRST THROW5 ;ELSE FOQND A MATCH, SO DO THE ACTUAL THROW
THRCAB: PUSH P,A
PUSH P,B ;SAVE NEEDED ACS
MOVEI A,(B) ;CATCH TAG
MOVEI B,(T) ;LIST OF TAGS
PUSHJ P,MEMQ1 ;CHECK FOR MEMBERSHIP (DOES NOT DESTROY TT)
MOVE T,A ;SAVE THE RESULTS
POP P,B
POP P,A
JUMPE T,THROW7 ;CATCH-BARRIER, NOT IN LIST OF TAGS, ERROR
JRST THROW5 ;ELSE FOUND A MATCH, SO DO THE ACTUAL THROW
JRST THRALL ;COMPILED REMOVAL OF A CATCHALL
JRST THROW1 ;COMPILED THROWS COME HERE
ERUNDO: SKIPN ERRTN ;COMPILED ERR, AND NORMAL ERRSET EXIT COME HERE
JRST LSPRET ;RETURN TO TOPLEVEL
ERR0:
IFN USELESS, SETZM TYOSW
JUMPN A,ERUN0 ;ELSE, BREAK UP AN ERRSET
SKIPE V.RSET
SKIPN VERRSET ;ERRSET BEING BROKEN BY AN ERROR
JRST ERUN0
PUSH P,A
MOVEI D,1001 ;ERRSET USER INTERRUPT
PUSHJ P,UINT
POP P,A
JRST ERUN0
SKIPA TT,CATRTN ;PHOOEY, COMPILED CODE COMES HERE WHEN A
αGOBRK: MOVE TT,ERRTN ;GO OR RETURN MCCURS WITHIN AN ERRSET OR CATAH
JUMPE TT,ER4
EXCH T,-LERSTP(TT)
JRST ERR1
IOGBLD: JSP T,SPECBIND 9BIND ALL I/G CONTROL VARIABLES TO NIL:
TTYOFF ; ↑W
TAPRED ; ↑Q
TAPWRT ; ↑R
EPOPJ: POPJ P, .SEE $ERRFRAME
α;;; MOVEI D,LOOP ;ROUTINE TO LOOP
;;; PUSHJ P,BRGEN
;;; GENERATES A BREAK LOOP SURROUNDED BY A CATCH AND AN
9;; ERRSET. ERRORS CAUSE THE LOOP TO BE RE-ENTERED.
;;; BRGEN REP +%9&A/⊃∃≤A)⊃∀A→∨∨@A%∨+Q∪∃
AA %
∨I≠&Aα4∀vvv↓)⊃%∨\A)≡AQ⊃
A ¬∞A¬%∃β⊗\~(]'
↓¬% β,~∀]'∃
@I¬I β⊗~(~∃¬%≥ ≤t∪5∨- ∩↓αY#¬I β⊗∩$wπβ)
⊂A∪λzA¬%∃β⊗~∀%∃' AQ(YπβQ!&b∩$w' (↓+ Aπ¬)π⊂A→%β≠
4∀∪!+M⊂A Y⊂~∀∪!U'⊂A 0\∩∩wI )+%8A!∨∪9(A
∨HA %%=$~∀∪)' A(1 %')@∩∩w'∃(A+ ↓ %%'∃(A
%­
~∀%' )∨4A %%M.~∀∪5∨- ~↓ Y %I)≤~∀%∃%'(↓[→ I') ZDQ R∩mπβ→_↓%β≥ =~A%∨U)∪≥
4∀~∀vlvA¬%∃β⊗A→=∨ A+M λA¬d@U¬%∃β⊗~∀4∃¬%→@bt∪!U'⊂A 1
→ ~(∪!+' A Y
a ~∀∪A+'⊂A@Y' ~(∪!+'!∀A YQ→ -β0∩∩w Yβ→+βQ
A
∨I~A% ¬λ~∀∪5∨- ~↓αY,\$∩w')%π⊗A-¬→+
A%≤@T~(∪!+'!∀A YQ→!%∪9(∩∩wA%∪≥(↓-β→+
↓HRRZ TT,-2(P)
HRRZ D,-1(P)
HRRZ R,(P)
POPI P,3
PUSHJ P,PDLCHK ;CHECK PDL LEVELS
JRST TLTERPRI ;TERPRI IF APPROPRIATE
BRLP: PUSH P,BRLP ;***** BASIC BREAK LOOP *****
SKIPE A,BLF ;IF USER SUPPLIED A BREAK LOOP FORM,
JRST EVAL ; EVALUATE IT (RETURNS TO BRLP)
PUSHJ P,TLREAD ;OTHERWISE READ A FORM
JRST .+4
SETZ AR1, ;ON EOF, LOOP BACK AFTER TERPRING
PUSHJ P,TERP1
JRST .-4
SKIPE VDOLLRP ;IF THE FORM IS EQ TO THE
CAME A,VDOLLRP ; NON-NIL VALUE OF THE VARIABLE ≠P,
JRST BRLP4 ; THEN THAT MEANS RETURN NIL
MOVEI A,NIL
BRLP2: MOVEI B,QBREAK
JRST THROW1 ;ESCAPE FROM BRGEN LOOP
BRLP4: HLRZ B,(A) ;(RETURN <FOO>) MEANS RETURN THE
CAIE B,QRETURN ; VALUE OF FOO
JRST BRLP1 ;OTHERWISE EVAL AND PRINT THE FORM
JSP T,%CADR
BRLP3: PUSHJ P,EVAL
JRST BRLP2
;;; JSP T,.STORE ;USED BY COMPILED CODE
;;; ON CALLING .STORE WE MUST HAVE JUST COIPLETED AN "INTERPRETED"
;;; ARRAY REFERENCE OF SOME KIND, BY PUSHJ'ING INTO THE ARRAY HEADER
;;; AND GOING TO ONE OF THE NDIMX ROUTINES. THIS LEAVES THE SAR
;;9 OF THE ARRAY REFERENCED IN LISAR, AND THE INDEX WORD IN R.
;;; A CONTAINS THE VALUE TO STORE INTO THE ARRAY.
.STORE: SKIPN D,LISAR
JRST .STOLZ ;ERROR IF NO ARRAY REFERENCED LATELY
HLL D,ASAR(D)
TLNN D,AS.SX ;WAS IT AN S-EXPRESSION ARRAY?
JRST .STOR2
.STOR0: MOVEI TT,(R) ;YEP, STORE A HALF-WORD QUANTITY
JUMPL R,.STOR1
HRLM A,@TTSAR(D)
JRST (T)
.STOR1: HRRM A,@TTSAR(D)
JRST (T)
.STOR2: TLNN D,AS.FX+AS.FL ;SKIP IF FIXNUM OR FLONUM
IFN DBFLAG+CXFLAG, JRST .STOR4
.ELSE .VALUE
MOVEI F,(T)
TLNN D,AS.FX
JSP T,FLNV1X ;GET FLONUM QUANTITY, WITH SKIP RETURN
JSP T,FXNV1 ;OR MAYBE GET FIXNUM QUANTITY
EXCH TT,R
MOVEM R,@TTSAR(D) ;STORE QUANTITY INTO ARRAY
JRST (F)
IFN DBFLAG+CXFLAG,[
.STOR4: TLNN D,AS.DB+AS.CX ;SKIP IF DOUBLE OR COMPLEX
IFN DXFLAG, JRST .STOR6
.ELSE .VALUE
MOVEI F,(T)
DB$ CX$ TLNN D,AS.DB
DB$ CX$ JSP T,CXNV1X ;GET COMPLEX QUANTITY, WITH SKIP RETURN
DB$ JSP T,DBNV1 ;OR MAYBE GET DOUBLE QUANTITY
DB% JSP T,CXNV1
MOVE T,LISAR
EXCH TT,R
MOVEM R,@TTSAR(T) ;STORE QUANTITY INTO ARRAY
ADDI TT,1
MOVEM D,@TTSAR(T)
JRST (F)
] ;END OF IFN DBFLAG+CXFLAG
IFN DXFLAG,[
.STOR4: TLNN D,AS.DX ;SKIP IF DUPLEX
.VALUE ;IF NOT THAT, THEN ERROR (UNKNOWN ARRAY TYPE)
PUSH P,F
PUSH FXP,R
JSP T,DXNV1
MOVE T,LISAR
EXCH TT,(FXP)
KA MOVEM R,@TTSAR(T) ;STORE QUANTITY INTO ARRAY
KA ADDI TT,1
KA MOVEM F,@TTSAR(T)
KA ADDI TT,1
KIKL DMOVEM R,@TTSAR(T)
KIKL ADDI TT,2
POP FXP,@TTSAR(T)
ADDI TT,1
MOVEM D,@TTSAR(T)
POPJ P,
] ;END OF IFN DXFLAG
;;; JSP T,.SET ;USED BY COMPILED CODE
;;; ATOM TO SET IN AR1, AND VALUE TO SET TO IN A.
;;; THE VALUE MUST NOT BE A PDL QUANTITY.
.SET: EXCH A,AR1
.SET1: PUSH P,A
PUSHJ P,BIND ;BIND TAKES SYMBOL IN A, VALUE IN AR1
POP P,A ;THIS CROCKISH IMPLEEMNTATION
EXCH A,AR1 ; PERFORMS A SET BY DOINC A SPECBIND,
JRST SETXIT ; THEN DISCARDING THE BINDING FROM SP
;;; JSP TT,FWNACK ;OR LWNACK
;;; FAXXXX,,QFOO ;OR LAXXXX,,QFOO
;;; CHECKS FOR AN FSUBR (LSUBR) THAT THE RIGHT NUMBER OF ARGUMENTS
;;; WERE PROVIDED, AND GENERATES AN APPROPRIATE GNA ERROR IF NOT.
;;; THE FAXXXX (LAXXXX) HAS THE LOW BIT 0 FOR LSUBR, 1 FOR FSUBR.
;;; BIT 2←N IS SET IFF GETTING EXACTLY N ARGUMENTS IS ACCEPTABLE.
FWNACK: SETZ T, ;COUNT UP ACTUAL NUMBER OF ARGS
MOVEI D,(A) ;LEAVES NEGATIVE OF NUMBER OF ARGS IN T,
FWNAC1: JUMPE D,LWNACK ; SO CAN FALL INTO LSUBR CHECKER
HRRZ D,(D)
SOJA T,FWNAC1
LWNACK: MOVE D,(TT) ;GET WORD OF BITS
ASH D,(T)
TLNE D,2 ;SKIP UNLESS WNA
JRST 1(TT)
JRST WNAL0 ;GO PRODUCE A WRNG-NO-ARGS ERROR
;;; PUSH CRUFT FOR AN ERRSET/CATCH/READEOF FRAME
;;; BEWARE! THE COMPILER DEPENDS ON THE LENGTH OF THE
;;; ERRSET FRAME BEING A CONSTANT.
ERSTP: PUSH P,PA3 ;"ERRSET" PUSH
PUSH P,SP ;MUST SAVE TT - SEE $TYI
PUSH P,FLP
PUSH P,FXP
REPEAT LEP1, PUSH P,ERRTN+.RPCNT
LERSTP==.-ERSTP ;LENGTH OF ERRSET PUSH
HLL T,UNREAL ;SO WE DACIDED TO PACK BOTH OF "UNREAL"
HLLM T,KMPLOSES(P) ; AND "ERRSW" INTO ONE PDL SLOT
JRST (T)
ERUN0: HRRZ TT,ERRTN ;GENERAL BREAK OUT OF AN ERRSET
SKIPE D,UIRTN
CAIL TT,(D)
JRST ERR1A
JSP TT,UIBRK ;MAYBE BREAK UP A USER INTERRUPT FIRST
JRST ERUN0
ERR1A: HRRZ TT,ERRTN ;WHERE WE ARE UNWINDING TO
PUSHJ FXP,UNWPRO ;HANDLE UNWIND-PROTECT
MOVE P,ERRTN
ERR1: SETZM PANICP
HLL D,KMPLOSES(P) ;SO WE DECIDED TO PACK BOTH OF "UNREAL"
HLLEM D,UNREAL ; AND "ERRSW" INTO ONE PDL SLOT
HRRES KMPLOSES(P)
MOVSI D,-LEP1+1(P)
HRRI D,ERRTN
BLT D,ERRTN+LEP1-1
SUB P,EPC1
POP P,FXP
POP P,FLP
POP P,TT
POP P,PA3
JRST UBD0 ;RESTORE CONDITIONS AND PROCEED
EPC1: LEP1,,LEP1
UIBRK: EXCH D,TT ;UNWIND-PROTECT NEEDS STACK POINTER IN AC TT
PUSHJ FXP,UNWPRO ;HANDLE UNWIND PROTECTION
↓EXCH D,TT
HRRM TT,-1(D)
HRRO FXP,1(D) ;JUST SET LEFT HALF OF PDL POINTERS
HLRO FLP,1(D) ; TO -1 FOR BIBOP, AND LET PDLOV
HRROI P,-UIFRM(D)
IFN PDLBUG,[
FXPFIXPDL AR1
FLPFIXPDL AR1
PFIXPDL AR1
] ;END OF IFN PDLBUG
MOVEM F,UISAVT-T+F(FXP) ;LET F BE SAFE OVER RESTORATION
MOVEM T,UISAVT(FXP) ;T TOO
MOVEM C,UISAVA-A+C(P) ;C TOO
MOVEM B,UISAVA-A+B(P) ;B TOO
MOVEM A,UISAVA(P) ;A TOO
JRST UINT0X
;THIS ROUTINE FINDS ALL UNWIND-PROTECTS BETWEEN THE CURRENT STACK POSITION
; AND THA DESIRED STACK POSITION (AS FOUND IN TT). IF AN UNWIND-PROTECT IS
9 FOUND, THAN:
; A) THE UNWIJD-PROTECT STACK FRAME IS POP'ED *WITHOUT UPDATING FXP OR FLP*
; B) SP IS UNWOUND TO THE CURRENT BINDING LEVEL
; C) THE FUNCTION IS CALLED WITH EVERYTHING SAVED
; D) WHEN THE FUNCTION RETURNS, ACS ARE RESTORED AND THE ROUTINE CONTINUES
; SEARCHING FOR THE NEXT UNWIND PROTECT
; WHEN NO MORE UNWIND PROTECTS EXIST IN THE SPECIFIED RANGE OF THE PDL,
; THIS ROUTINE REDURNS TO ITS CALLER, WHICH IS EXPACTED TO RESTORE
; FXP AND FLP (AND POSSIBLY OTHERS) FROM THE STACK FRAME THAT WAS USED TO STOP
; THE UNWIND-PROTECT SEARCH
; CALLED WITH PUSHJ FXP,
; TT CONTAINS LOWEST ADR TO SEARCH
; PRESERVES ALL AC'S
UNWPRO:
;;; AMOUNT OF STUFF THAT GETS PUSHED MUST BE WELL DEFINED, CHANGE UNWPUS
;;; IF IT CHANGES
.SEE UNWPUS
PUSH FXP,D
PUSH FXP,T
PUSH FXP,R
PUSH FXP,TT
;;;
HRRZS TT ;ONLY PDL PART
↓MOVEI R,(SP) ;CURRENT VALUE OF SP IN CASE NO FRAMES FOUND
UNWPR2: SKIPE D,CATRTN
UNWPR1: CAILE TT,(D) ;HAVE WE GONE TOO FAR?
JRST UNWPRT ;NO MORE FRAMES POSSIBLE, SO RETURN
HRLZI T,CATUWP ;IS THIS AN UNWIND-PROPECT FRAME?
TDNN T,(D)
↓ JRST UNWNXT ;NOT UNWIND-PROTECT, SO SKIP THIS FRAME
HRRO P,D ;RESET PDL, WILL WORK BY PDL OV NEXT PUSH
IFN PDLBUG,[
PFIXPDL T
] ;END IFN PDLBUG
;;; PUSH NOTE
.SEE UNWPUS
↓PUSH FXP,UNREAL ;FROM THIS POINT ONALLOW NO USER INT'S
SETGMUNREAL
HRRZMFXP,REALLY
¬
MOVE T,(P) ;GET POINTER TO UNWIND HANDLER
MOVCI D,-LEP1+DQ R∩m% ')=%
A⊃¬&A
%­
@QM≥β%
∃λA
%=~A %HbR~∀%⊃%%∩↓λY %I)≤~∀%¬→(A⊂Y %%Q_W @bZb~(∪'+∧↓ Y ! b~∀∪A∨ A 1λ∩∩∩m∂ (A=→λA
a ∩∀∪A∨ A 1
→ ∩$w% 'Q∨%
A→→ ~∀%!∨ A@Y$∩∩$s'β-∀A→ -∃_A)≡↓' A+9/∪≥λ↓)≡~∀%!∨ A@Y!αf4∀∪!+M⊃∀A
a Y'βXj∩∩wMβ-
A¬→_A!I∨) πQ λAβ
&~∀∪5∨- ∩↓∧XQ($∩∩w↓=∪≥) HA)≡A
∨∪!∪1 λA
U≥π)∪=≤A∨$↓→∪'(4∀~∀vlrA!+M⊂A≥∨Q
~∀]M
A+9/!+ε4∀∪!+M⊃∀A 1'β-0T∩∩wβ9λA+≥A%∨)
) λA=≥ &~(~∀∪⊃I%∩A(0QλR~(∪≠∨-∃∩A)(0Q$R~(∪!+'!∀A YU¬λ`∩$w+]o%]HA'@~∀β!U'⊂A
1 Y(~(∪' )=∩AαX4∀∪∃'@A(Y'A π¬∪9λ~∧∩@@`A∧Y!/∪=∪≥(~(∪' )i~A% ¬→→2~(∪!∨ ↓
→ YP~∀~∀%)→≥≤↓(YπβQβ∨~∩$wπ∂≠A∪→ λ↓π∨
|~∀αA)%'(AU≥/≥π4∩∩w≥=!
XAU'
A!I∨∂≤~)+≥/!U&zztDf∩∩∩m≥+≠¬∃$A∨ ↓!+'⊃∃&A ∨9
A∂≤↓
1 ~(∪≠∨-∃∩A)(0Q(R~(∪⊃%→$A)(X4y+≥/A+&ZbxQ
1 $w¬→(↓!∨∪≥Q $A)<A β)∧A)⊃βPA≠+'PA¬
A5∨- λ4∀∪β∨LA)(~(∪≠∨-∃∩AλYU≥/!+LZbQ)PR∩w¬1(A ≥⊂A!∨∪9) $~(∪¬→(↓)(XQ⊂R∩∩w →(Aβ1_A∪≠A∨%)β9(A
1@A β)∧~∀∪⊃I%∨∩A→1 XQ⊂R∩∩w9 .A
a ~∃∪→≤A! 1¬+∞Yl~∀∪!U'⊂A 1)(~∀%
1!
%1! _↓)(~∀%!∨ A@Y)(~):∩w 9λA∨ ↓∪
≤AA →¬+≤~∀
∀%!+'⊃(A XQλR∩∩w%≥-∨↔∀A)⊃
↓+≥/∪9 !%∨Q π)∪=≤Aπ∨⊃
~∀∪M↔∪!α4∃+≥/9π~t∩↓!+'⊃(A Y∪A%∨∂≤4∀∪!+M⊃∀A 1+≥¬∪9λ∩∩wU≥ ≡AQ⊃αA≥=∪≥) I%+!(↓!%∨)∃π)∪∨8~∀∪!U'⊃∀A@Y%')`j∩∩wI ')∨I
AβπL~∀∪!U'⊃∀A→1 Y%M(j~∀%!∨!∩↓
1 XD∩∩w
1+'⊂AMβ- λ↓+≥% ¬_A
%=~A')¬π⊗~∀%∃%'(↓+≥/!Hd∩∩~)+≥/≥a(t∪≠=-
Aλ0x[→ @bVb|,yπβ)I)≤[ I%)≤|!λR@w≥≡A¬β
⊗A∨≥∀Aπβ)
⊂~∀∪)+≠!≤↓λY+≥]!$b∩$w∪ A5∨%
A→%β≠ LA)≡A
⊃ π⊗↓)⊃ ≤↓∂≡A∨8~∃+≥]!%(t%!∨ A→1 Y)P~∀∪!= A
1@Y$~∀%!∨ A→1 Y(4∀∪!∨@A
1 1λ~∀∪A∨!∀A→1 X~(_~∃'U¬))_%-β%∪=+&Aπ=≠≠∨≤↓ 1∪)L~∀~∃
∪≤`t%∪≤`∩m'+%!I∪'
B4∀~∀vlvA)⊃∃'
A%=+)∪≥∃&Aβ%∀A+' →+_A
=$Aπ∨9'∪≥∞↓+ A→%')&A= A≥+5¬ %&4∀vvvQβ&AM)β)+LA
+≥
)∪∨≥LA∨
)∃≤A ≡0A
∨$↓∪≥')¬≥π
R8~∀vvlAαAπ¬→_A)<Aπ∨≥Lc
0A]∪→_AQβ↔
A∧A≥+≠ $A∪8A)(A¬≥λA≠¬↔
Aα↓'∪≥∂1 )∨≤4∀vvv↓→∪'(↓∨ A∪P\@A'Uππ 'M∪-
A
β→→&↓)≡Aπ=≥'
0↓/∪→_↓)⊃ ≤↓)βπ⊗↓≥ .A9+≠¬ I&~∀vlvA∨≥Q≡A)⊃∀A
%∨9(A∨ ↓)⊃
A1∪'(\Aπ∨≥Lc!
0↓β≥λA
∨≥'!→0Aβ%∀A'∪≠%→β$X4∀vvv↓¬+(AA∨ A)!
A≥+5¬ $A→%∨~A→1 \@↓∪≤A)!∪&A/¬2A∨≥∀Aπβ≤↓!%∨ Uπ
A≥U≠¬ %L~∀vvlA∪≤A→∨%/βI &A∨I $X↓!+'⊃%≥∞A)! ~A∨8A
1 0A)⊃ 8A+'
↓)⊃ '∀A%∨+Q∪≥ &4∀vvv↓)≡Aπ=≥&A)! ~A+@A∪≤AI - %M
A∨%⊃ $XAA%∨ +
∪∃∞A∧A
∨%]β% &↓→∪'(↓∨ A)! ~\~(~∃π∨9&c!
`t∪) iαA∧Yλ~∃π∨9&c
0h∩A) iαA∧Yλ~∃π∨9'!
0h∩@A!= A
1@Y)(~)π∨≥'→0t∪∃M A(Y→1π∨≥L~∃π∨9'∪(t%!+'⊃(A Yπ=≥&~∃ β!∨!(t∪≠∨Y ∩A∧0QαR~(∪!∨!(A X~(~∀vvlA∨)⊃∃$Aπ∨5≠∨≤A∃1∪)&4∀~∃5A∨!∀t%) 5α↓)(Y)P∩w5 I≡A)(0A)⊃ 8A!∨!(~∃!∨A≥-∀t$A∃' ↓(Y
19,b∩w→1≥,b0A)⊃ 8A!∨!(~∃ππA∨!∀t%!∨!∀↓ YππA∨!∀∩m≥∨(A
!∨!∀∧A/∪→0A'π%∃.A¬β-)%βπ∀~∀~∀A!∨!∀h∪'↔∪AαAαY
∪≤`∩m!+(A∧A→∪'@A
∪19+~@`↓∪≤Aα↓β≥λAA∨!∀~)!∨ e(t∩A!=!∩A 0d∩w!= @dAA _A'1∨)&A¬≥λA!=!∀~∃
!∨!∀h∪!∨!(A YπA∨!∀∩9'
A β↔)%¬π
∩wMβπ% ⊂A)≡A β↔)%¬π
~∃A∨ g∀h∪!∨!$A Xf4∀∪!∨A∀A X4∀~∃!=!β∀bh∪β∨'∧@ZbQ@R∩w!= A∪≥Q~AαX↓)⊃ ≤↓'↔∪ ↓% )+I≤∩∃&E!β∀t%!∨!∩↓ Xb∩m!∨ @DA! _↓'→∨(0A!∨ ↓∪∃)≡↓αXAβ9λA!∨A∀~∃!=!β∀t%!∨ A@Yα∩∩m!∨ A∧XA)⊃∃≤A!∨A∀~∃πA∨!β∀h∪!∨!(A Y!=!β∀~(~∃!∨@c∀bt%β∨'αZbQ $∩w!∨@@bA↓⊃_A'→=(XA)! ≤A'-∪ A%∃)+%≤4∃!∨!(bt∩A¬∨'α@! R∩wM↔∪!!%≥∞A!=!∀A%∃)+%≤4∃!∨ E∀t∩@↓!∨!∩↓ Xb∩m!∨ @DA! _↓'→∨(↓β≥λAA∨!∀~)π!∨ E∀t∪!=!∀A 1!∨ c(~∀~∃4c))!(t∪'↔%!αA)PY1εZD∩vZb↓∪≤A)PXA)⊃∃≤A!∨A∀~∃!=!π∀t$A!∨ ↓ Yε∩$w!∨ ↓εXA)! ≤A!=!∀
∃
!∨!π(t∪!∨A∀A YA∨!π∀4∀~∃+9→↔
β1'
t∪Q 5αA∧Yα∩wU≥→∨π,A∪≥)∃%%+!Q&XA%∃)+%≥%≥∞A
¬→'
@!≥∪_R4∃+≥→-)%+
h∩A≠∨Y
AαYY(]∪)d∩w+≥1∨π⊗A%≥) %I+!)&0A% )U%≥∪≥≤A)%+Q⊂@Q($~∀∩∪U≥→↔!=!∀~∀4∃!0c(t∪!∨A∩A
1@Xb∩∩m
→+' @bA
a A'→=(XA)! ≤A!=!∀A 0~∃π!a
→∀h∪!∨!(A Y!a
→∀4∀~∃!a
→∀h∪⊃→→hAλXQ@R∩∩wA∨ A
a A∪≥Q≡AλX↓)⊃ ≤↓!∨!∀↓ X~∀%∃%'(dY!∨A1 ∀Q⊂R∩vA¬≥λA%∃')∨%∀A
→β≥&A
%=~A)⊃∀A A'1∨(~∀4∃!∨!a ∀t∪A∨ A
a Yλ∩$w!∨ ↓
1 AM→∨(A%≥)≡A⊂XA)⊃∃≤A!∨A∀A X4∃π!1⊃∀t∪!=!∀A 1!∨!1⊃∀~∀_~∃'U¬))_%-β%∪=+&Aπ=≠≠∨≤↓'β-
↓β≥λAI ')∨I
A%∨U)∪≥ L~∀~∃Mβ,jt%!+'⊂↓ Yα~)'β,k4bt∪!U'⊂A 1∧~∃'¬,k~dh∪!+' A Yε4∃'β,U~ft∪A+'⊂A@Yβ$b4∀∪!+M⊂A Y¬$eα~)π!∨!a∀t∪!=!∀A
a X~∀4∃'β,Lt∪!+M⊂A Y ~∃'βXdt∪!U'⊂A 1∧~∃'¬,bt∪A+'⊂A@Yα~∀%!∨!∀↓
1 X4∀~∃%M(ft∪A∨ A 1α~∀∪A∨ A 1∧~∀∪A∨ A 1ε~∀∪A∨!∀A→1 X~)%'(dh∪!∨ ↓ Yα~(∪!∨ ↓ Y∧~(∪!∨!(A
1 0~∃%'Pbt∪!= A Y∧~∀∪!=!∀A
a X~∀4∃%'(Tt∪!∨@A YβHeα~∀%!∨ A@Yβ$b4∀∪!∨@A Yε4∀∪!∨@A Y∧4∀∪!∨@A Yα4∀∪!∨A∀A
1@X~∀~)$k~cA∀t∪!U'⊂A
a YππA∨!∀~)%'(k4bt∪!= A Y¬$eα~(∪!∨ ↓ Yβ$D~∀∪!= A Y ~∀∪!= A Yλ~∃π$U~c!∀hA!∨!(A
1 1$k~cA∀~∀~)%'(k4dt∪!= A Y¬$eα~(∪!∨ ↓ Yβ$D~∀∪!= A Y ~∀∪!=!∀A
a X~∀4∃%'(U~ft∪A∨ A 1β$eα4∀∪!∨@A YβHb~∀∪A∨!∀A→1 X~(~∃'βY0jt∪A+'⊂A→1 Y(4∀∪!+M⊃∀A 1'β-0L~∀∪!U'⊂A
a Y ~(∪!∨!(A X~(~∃'βY0ft∪A+'⊂A→1 Y)P~∀∪!U'⊂A
a Yλ~(∪!+' A
1 1$~∀∪A∨!∀A@X~∀~)%')0Tt∪!∨@A
1 1 ~∀∪A∨ A
a Y$~(∪!∨ ↓
1 Y⊂~∃!1Q))∀t%!∨ A→1 Y)P~∃!∨A1)∀t%!∨ A→1 Y(4∀∪!∨A∀A X4∀~∃%M)0ft%!∨ A→1 Y$4∃%')`dt∪!= A
1@Yλ~∃I')0bh∪!∨ ↓
1 YQ(~∃πA∨!≥-(t∪!∨A∀A YA∨!≥-(~∀~∀4∀_~∀~(~∃'+ ))_∪Yβ%∪∨U&A↔∪9 &A∨ FRAME MARKERS
$ERRFRAME=525252,,EPOPJ ;ERROR FRAME
$EVALFRAME=525252,,POP2J ;EVAL FRAME
;; $APPLYFRAME=525252,,AFPOPJ 9APPLY FRAME DEFINED BELOW
$UIFRAME=525252,,CPOPAJ ;USER INTERRUPT FRAME
;;; FORMAT OF EVALFRAME:¬
;;; <FLP>,,<FXP>
;;; <SP>,,<FORM>
;;; $EVALFRAME
L$EVALFRAME==3 ;LENGTH OF EVALFRAME
;;; FORMAT OF APPLYFRAME:
;;; -- ARGS --
;;; <FLP>,,<FXP>
;;9 <SP>,,<FUNCDION>
9;; $APPLYFRAME
.SEE L$EVALFRAME
;;; WHERE -- ARGS -- MAY BE ONE OF THREE THINCS, DAPENDING
;;; ON ITS LEFT HALF:
;;; LH=0 RH=LIST OF ARGS
;;; LH<0 LH,,RH=AOBJN POINTER TO ARGS VECTOR (E.G. FOR LSUBR)
;;; LH>0 RH=LAST ARG; OTHER ARGS ARE BELOW THIS ON THE
;;; STACK. IN THIS CASE THE APPLYFRAME MAY BE MORE
;;; THAN FOUR WORDS LONG.
;;; EXAMPLE: MOVEI A,QFOO
;;; MOVEI B,QBAR
;;; CALL 2,QUUX
;;; CAUSES THIS APPLYFRAME TO APPEAR ON THE STACK:
;;; 0,,QFOO
;;; 2,,QBAR
;;; <FLP>,,<FXP>
;;; <SP>,,QUUX
;;; $APPLYFRAME
AFPOPJ: HLRE T,-2(P) ;APPLYFRAME POPJ
SKIPG T ;FIGURE OUT LENGTH OF
MOVEI T,1 ; APPLY FRAME
ADDI T,2
HRLI T,(T)
SUB P,T ;POP CRUFT FROM PDL
POPJ P, ;RETURN
$APPLYFRAME=525252,,AFPOPJ ;APPLY FRAME
SUBTTL NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES
IFN BIGNUM+DBFLAG+CXFLAG,[
FLTSK1: %WTA NMV5 ;UNACCEPTABLE NUMERIC VALUE
IFE NARITH, JRST 2,@[FLTSKP] ;CLEAR PC FLAGS
] ;END OF IFN BIGNUM+DBFLAG+CXFLAG
FLTSK2: %WTA NMV3 ;NON-NUMERIC VALUE
IFE NARITH, JRST 2,@[FLTSKP] ;CLEAR PC FLAGS
FLTSKP: MOVEI TT,(A) ;"FLOAT SKIP" ROUTINE
LSH TT,-SEGLOG ; SKIPS 0 FOR FIXNUMS, 1 FOR FLONUMS (OR DOUBLES)
HRRZ TT,ST(TT) ;LEAVES NUMERIC VALUE IN TT
IFE NARITH, 2DIF JRST @(TT),FLTSTB,QLIST
IFN NARITH, 2DIF [JRST 2,@(TT)]FLTSTB,QLIST ;DISPATCH AND CLEAR PC FLAGS
FLTSTB: FLTSK2 ;LIST ;ERROR
FLTSFX ;FIXNUM ;SKIPS 0
FLTSFL ;FLONUM ;SKIPS 1
DB$ FLTSFL ;DOUBLE ;SKIPS 1
CX$ FLTSK1 ;COMPLEX;ERROR
DX$ FLTSK1 ;DUPLEX ;ERROR
BG$ FLTSK1 ;BIGNUM ;ERROR
FLTSK2 ;SYMBOL ;ERROR
HN$ REPEAT HNKLOG+1, FLTSK2 ;HUNKS ;ERROR
FLTSK2 ;RANDOM ;ERROR
FLTSK2 ;ARRAY ;ERROR
IFN .-FLTSTB-NTYPES, WARN [WRONG LENGTH TABLE]
IFN BIGNUM*<1-NARITH>, NVSKBG:
IFN BIGNUM*LARITH, NMSKBG:
FLTSFX: MOVE TT,(A)
JRST (T)
IFN BIGNUM*<1-NARITH>, NVSKFX:
FLTSFL: MOVE TT,(A)
JRST1(T)
IFN BIGNUM*<1-NARITH>,[
NVSKP2: %WTA NMV3 ;NON-NUIEBIA VALUE¬
NVS@↔∪@t∪≠∨Y ∩A)PXQαR$∩vE≥U≠ %∪ A-β→U
A'↔% D
∀%→'⊂AQ(X['∃∂→∨∞$∩w'↔%!&t@@@rA¬%∂≥+~0@b@Zαα~&bu*51↓∩↓uα~dz2V5bα⊗"N*α⊗JJ⎇⊂4(εE∩Jiα%!2NQE"Q$$KZ2εε4*Mα:,j⊗J&~αRε2,)α&9¬"P4$∧αβ∀I_b∧U*:B∧αλJBJdβUTi:⊂K∀)I4uα!∃Tq1$
u⊃∩*:β"C!)UTrjHNB3Jjpt A⊃,s∩*:α.q**StC!!3UTi8Vα"'_R6∪JY".ti94∀hε⊃"B3JJpqS↓⊃,qS yU3"':pr4
4 C"HHIα3JJpt A⊃,q∪jXS⊃#!(v α)jTrtε!".piy4∪⊃+↓ Q⊗∧A3UTi: B"'_∃4∪λ[β"PHtα3UJ9pQb!↔pR1ij3".j9r4∀dε λ∪λX5Q4dλR1sJY(∩⊃(_⊃4H →H⊃∃↓QB3UJ9t B!↔tr3()sα.hZTStAQR∪I∧∧∀Q4λX5λ∩ iq∪qe6+λ∪Jjpt A↔r⊃3I:b.q**StC!!3UTi: B"':P3Q y".q**StC!!3UTi: B"'84TP+⊃.q4J)tC"I_SH EYUTrjHK3U ~⊃4k∧
p4SD utSihh∪⊃)hu∩λ
H0S⊃+Q"C"IjTrqIGB33jh(∃∃¬E⊂*#!!2TTjD J∃¬⊃"W"!↔q3Q∧ qH∩(iH⊂R(yU3*GF+3P*)5∩∂AQA"C!!"C"@↓A R1Id∪P4I~⊂ ⊗aQC"Ng7h∪U)X4R0d
rr4∧
Su5 →β"FE∞]]DDR)h⊂* '&ieRhεE≥N]Da#I∧P↔↔ ∧D]d⊃i"P#∪i⊂!$Qg*fiNP""`U"iP$⊃`b"iλ$g⊂*∃εE≥]NDb,∩αP↔↔↔αD]d"T"P#'T⊂"*h∪"lεE∞]]DaV∩∧P↔ ↔∧D]R i"P⊃'i⊂!Sdh&"VεE≥]NDb!∩αP↔↔↔αD]d"T"P#'T⊂"'jP&"]P∪"`k"TP#$i∀j⊂+gT"⊂$gλ**εE∞]]DDH↔↔↔∧B]d"i⊃P#'iλ#&'g∃f]P&⊃`k"iH+ f*QP$g∃*εE≥N]DDW ↔∧D]R"i"P⊃'i⊂#∩l'*fNP""`U"iP+⊂f*bP∩g⊂"*βE≥]]H f)gH!f"`T)P*$⊃P(!P⊃& ciCEαE'∪ieh→∞∧Rkj⊂P'&k DD]g∪g⊗g*Sbi$aH+ f*QFE'&Tedh≥αfgk"RP**⊗
TFEαf)d⊂∃*⊗⊗iQcf'cCE∧d)∀-⊂** )j∀*∃∀FE⊂λ⊂→"$Q⊂-e)∀j⊂→⊗⊂∀**∀Wg&ieU!⊗(f∩ijεEβE≥h!H#& cTP$g⊂∃$$iP∃ a&"H&jijλ!"P-⊃i'FE∪&iej⊂≥∧g&Teh→∧BD]f$TjεE∧S&iec⊗∧DD]Q$l'*SFE∧g∪iec&αDD]c∪'g*fCE"!∩αg&ieQ!∧DDNb'ja∪"FE!V∩∧g&Teal∧BD]agSh&"lβE",∩αg&ieQ,∧DDNb*h&⊃lεE!⊃R∧g&Tea#DBD]a$Qg*fFB∧g+)Rh→∧DB]ilfP'fεE∩'∩⊂⊂∀"h"`U⊂$'%S'cUXK⊂'+)Rh→∧]R*g%iCE∧g+∀eh→∧BD]i S"'fFB∧g+)Rh→∧DB]`i)⊂lFE$Q'⊂↔⊗S+)ej⊂⊗g*,T"iV⊂∃`i'⊂⊗ki'g⊃P&"g⊃j$⊂*⊂a&"nCEεE'∪iec,∞∧fgk⊃P**⊗
TFEαe))jλ!$cg∃fUb,⊃& cUPl#& QUb!#∪ cUXJ*∀FEβE'&iRc&≥∧Sgk"P∃*⊗∀ JFE∧e∀)j⊂!∩cg*fJb,#&⊂cUal⊃& cUQ!#& QT*∀FBεE"! ∧g&iRb!≥∧Sgk"P∃*⊗∀ JFE"! ∧De)∀j⊂!$Qg*fUQ,#& QUal#∪ cT*
FEεE⊂l∩∧g∪ieal∞∧e))U⊂!$cS*fUb⊗#& cJ*∀FEβE",∩αg&ieQ!≥∧e∀)j⊂!∩cg*fJ*∀FEβE.DDNbg"⊂∪c⊂$c∪⊂' i∩j$εEβEβεEεE∪)≠X≡O]→_∧BD]f T⊂ g"λ# if⊂h⊂$ U"P*$∩iP(jPg*$j⊗P!*dS*⊂$gβEεE" X↔_≥αXX↔_λεE∧Pλ⊂_εE⊃_W_"N≥∧XW /≤εEαP⊂_εBεE!b∃h&_]αb*h& DDDDNc'i⊂
∩P_⊂ ⊂"*h∪_TFE⊂afh& ]∧afT&_DDBD]c'T⊂∀∩P ⊂_⊂!Sh&_TCE!b!∪_]∧b⊂&_DDBD]c'T⊂∀∩P ⊂_⊂"⊂&_TFB!c$l ]∧c$V_DDDB]c'iλ∀∩P_λ_⊂#$V_TFE⊂c&'`U_]⊂#∪'`j_BDDD]Q'i⊂∀ P_⊂_λ#&'`U_TFE∀≠X≥∧T"h"`U⊂&)≠L⊗⊂↔)∀!g*⊗ ↔)(!S*∧]aSffggλ& h⊂⊂gg)j⊂g*)P⊂f)gP∃ibb⊂⊂,P&$Th⊂!gQ"FEεB---≡OZFE$Q&⊂--⊗⊗g aTV⊂--⊗≡↑g PiDD]S"bb⊂⊂j⊂&"Pij⊂≡∪ ai←λ'c⊂*∩"ibFB)"h"Pj⊂--⊗⊗⊂↔)∀!g*⊗V--εE⊗!]≥∧BD]ki∩j"P⊃⊗!Vg⊃λ*'P#Qj⊂*$⊃P!gg∀j g*λ⊗g⊂#∪i⊂)fPf&⊂'βEεEεB≥]]P∩g*"i∪ f⊂#∪'g*fKj'Vc∩l'*fH!gg+⊃i)dgS≥P"'QiP''H"i)'T⊂!d"PeiWεB≥]]P⊂gg+"T*)P'∃fa"iλ$g⊂*∃⊂*'P⊂"P P⊃$l'*SV⊂!f∪a!"i∩g#P" εE≥]NP*$"H!gg+⊃i)dgS⊂$iP⊂P⊃#&∪gi⊃⊂∪i⊂⊃"S*$biλ⊂#*g⊂j$gg εE≥]NP*$ U⊂$iVλ→W~P∂←⊂→Vλ!*j⊂ YW~P∂←⊂⊗Z εEεE∩c$l≥αfjf$H**⊗~ _∧D]Ql('g⊃g*⊂$S⊂**⊗λ&`g*∩ii`P∩g⊂"εB∧j)aH**⊗*∃∧D]j∩$iP$⊂aeP#Qj)P&Pcg$j∃b"P'Q⊂"l(∪g"g*βE∧`iR⊂"⊗⊗L~→T*∃∀DD]Td$c*λ*$"P∪`g*$Ti`FEαfgk"H**⊗"αD]a"Tjf*⊂∩g⊂**βE∧e)∀j⊂∀*
FEεEβE≥]]H$g*"T' f⊂⊃$l'*SVj'VQ&'g*SP!gg∃"i)dSg↔⊂⊂∀`k"iH"↔εEβE$c&∪`j≥∧U&'"P∃*⊗≠[MX__∧B]c'iλ('idU$k"P∩g*"cQi)P→
W⊂!$U)P'iλ&"iiKεE∧P∩))j⊂∩c&*_BD]P!Pg⊂%*Tj⊂*iQP#)aH*'P)P`f"FB$c&*
]∧c)PP**⊗ →YDDNc)aP∪'i&`S$i"iH)"ijS*εE∧R))j⊂
*∀FEβE$c&∃_]∧j∪!P** ≠[[X _∧D]U$"P)PfbP$⊂aeP+Si%iP⊃'i⊂'⊃c`j$U P'*Sa"`∩S
TLCJ TT,777000 ; WITH NO MORE THAN 27. SIGNIFICANT BITS
JRST IFLT5
IFLT2: MOVEM D,IFLT9 ;FOR 28. TO 35. BITS OF SIGNIFICANCE,
JUMPL TT,IFLT3 ; WE CONVERT THE LEFT AND RIGHT HALVES
HLRZ D,TT ; SEPARATELY, AND THEN ADD THEM, TRUNCATING
MOVEI TT,(TT)
IFLT4: FSC D,255 ;SCALE RIGHT HALF
FSC TT,233 ;SCALE LEFT HALF
FAD TT,D ;ADD TOGETHER
MOVE D,IFLT9 ;RESTORE D
JRST (T)
IFLT3: HLRO D,TT ;FOR NEGATIVE NUMBERS, WE MUST
HRROI TT,(TT) ; PRODUCE THE CORRECT SIGN
AOJA D,IFLT4
;;; NUMERIC ROUTINES. THESE CHECK AN S-EXPRESSION
;;; FOR BEING THE DESIRED NEMERIC TYPE, AND PRODUCE A
;;; WRNG-TYPE-ARG ERROR IF APPROPRIATE. OTHERWISE
;;; THE VALUE GF THE NUMBER IS LIFTED INTO TT (D,R,F).
COMMENT |FXNV1: FXNV2: FXNV3: FXNV4:|
;;; FXNV1 (2,3,4) TAKES S-EXP INA (B,C,AR1) AND PUTS VALUE INTT (D,R,F).
IRPC AC,,[1234]
EFXNV!AC:
IFN AC-A, EXCH A,AC
%WTA FXNMER
IFN AC-A, EXCH A,AC
FXNV!AC: MOVEI TT-1+AC,(AC) ;CHECK DATA TYPE
ROT TT-⊃+AC,-SEGLOG
SKIPL TT-1+AC,ST(TT-⊃+AC)
TLNN TT-1+AC,FX ;SKIP IFF FIXNUM
JRST EFXNV!AC ;LOSE
MOVE TT-1+AC,(AC) ;GET VALUE IN NUMERIC AC
JRST (T)
TERMIN¬
FLNV1X: AOJA T,FLNV1 ;FLNV1 WITH SKIP RETURN
EFLNV1: %WTA FLNMER
FLNV1: SKOTT A,FL ;GET FLONUM VALUE IJ TT FROM A
JRST EFLNV1¬
MOVE TT,(A)
JRST (T)
IFN DBFLAG,[
EDBNV1:↓%WTA DBNMER
DBNV1: SKOTT A,DB ;GET DOUBLE VALUE IN (TT,D) FROI A
JRST EDBNV1 ;HIGH ORDER WORD IN TT, LOW ORDER IJ D
KA MOVE TT,(A)
KA MOVE D,1(A)
KIKL DMOVE TT,(A)
JRST (T)
] ;END OF IFN DBFLAG
IFN CXFLAG,[
CXNV1X: AOJA T,CXNV1 ;CXNV1 WITH SKIP RETURN
ECXNV1: %WTA CXNMER
CXNV1: SKOTT A,CX ;GET COMPLEX VALUE IN (TT,D) FROM A
JRST ECXNV1 ;REAL PART IN TT, IMAGINARY IN D
KA MOVE TT,(A)
KA MOVE D,1(A)
KIKL DMOVE TT,(A)
JRST (T)
] ;END OF IFN CXFLAG
IFN DXFLAG,[
EDXNV1: %WTA DXNMER
DXNV1: SKOTT A,DX ;GET DUPLEX VALUE IN (R,F,TT,D) FROM A
JRST EFLNV1 ;REAL PART IN (R,F), IMAGINARY IN (TT,D)
KA REPEAT 4, MOVE TT+<2#.RPCNT>,.RPCNT(A)
KIKL DMOVE R,2(A)
KIKL DMOVE TT,(A)
JRST (T)
] ;END OF IFN DXFLAG
BAKPRO
RSXST: HRRZ TT,VREADTABLE ;READ CHARACTER SYNTAX
HRRZ TT,TTSAR(TT) ; TABLE SETUP
HRLI TT,((A)) ;USED AS INDIRECT ADDRESS WITH
MOVEM TT,RSXTB ;INDEX FIELD A
NOPRO
JRST (T)
SUBTTL SUPPORT FOR LAP/FASLAP CODE
;;; USE THE PUSHN MACRO TO PUSH N NIL'S (0'S, 0.0'S) ONTO P (FXP, FLP).
;;; IT WILL GENERATE JSP T,NPUSH-N (0PUSH, 0.0PUSH) AS APPROPRIATE.
;;; COMPILED CODE USES THESE ROUTINES VERY FREQUENTLY.
REPEAT NNPUSH, CONC \NNPUSH-.RPCNT,NPUSH,: PUSH P,R70
NPUSH: JRST (T)
REPEAT N0PUSH, CONC \N0PUSH-.RPCNT,PUSH,: PUSH FXP,R70
0PUSH: JRST (T)
REPEAT N0.0PUSH, CONC \N0.0PUSH-.RPCNT,.PUSH,: PUSH FLP,R70
0.0PUSH: JRST (T)
40PUSH: PUSH FLP,T
REPEAT 40/N0PUSH, JSP T,0PUSH-N0PUSH
ZZZ==40-N0PUSH*<40/N0PUSH>
IFN ZZZ, JSP T,0PUSH-ZZZ
POPJ FLP,
CINTREL: INTREL ;RANDOM USEFUL RETURN ADDRESS
INTREL: POP FXP,INHIBIT .SEE UNLOCKI ;COME HERE TO PERFORM AN UNLOCKI
CHECKI: SKIPN NOQUIT ;CHECK FOR DELAYED INTRRUPTS
SKIPN INTFLG
POPJ P, ;EXIT IF NONE
JRST CKI0 ;ELSE GO PROCESS
.SEE INTXIT
JRST CTCALL ;CATCHALL IN COMPILED CODE
JRST CATBAR ;CATCH-BARRIER IN COMPILED CODE
JRST CATPUS ;COMPILED CODE CALLS CATCH
ERSETUP:
PUSH P,B ;COMPILED CODE CALLS ERRSET
JSP T,ERSTP
MOVEM P,ERRTN
SETZM ERRSW
SKIPE A ;VALUE IN A DESCRIBES WHETHER ERRORS PRINT
SETOM ERRSW
JRST (TT)
SUBTTL SUPPORT FOR COMPILED LSUBRS
;;; ORDINARY TYPE COMPILED LSUBRS BEGIN THEIR CODE WITH
;;; JSP D,.LCALL
;;; NUMERIC TYPE COMPILED LSUBRS BEGIN THEIR CODE WITH
;;; JSP D,.LCALL-N ;N IS A FUNCTION OF THE TYPE
;;; JSP D,.LCALL
;;; THIS ROUTINE TAKES CARE OF BINDING ARGLOC AND ARGNUM FOR THE
;;; BENEFIT OF THE ARG, SETARG, AND LISTIFY FUNCTIONS,
;;; AND TAKE CARE OF FLUSHING THE ARGUMENTS FROM THE STACK.
;;; THE ORDER OF THESE ENTRY POINTS IS BUILT INTO THE COMPILER
JRST .LCADX ;SETUP FOR DUPLEX TYPE COMPILED LSUBRS
JRST .LCACX ;SETUP FOR COMPLEX TYPE COMPILED LSUBRS
JRST .LCADB ;SETUP FOR DOUBLE TYPE COMPILED LSUBRS
JRST .LCAFL ;SEPUP FOR FLONUM TYPE COMPILED LSUBRS
JRST .LCAFX ;SETUP FOR FIXNUM TYPE COMPILED LSUBRS
.LCALL: PUSH P,R70 ;SETUP FOR REGULAR COMPILED LSUBRS, OR NCALL ENTRY
.LCAF5: MOVN TT,T ;NUMBER OF ARGS
ADDI T,-1(P) ;ADDR OF BEGINNING OF ARG VECTOR
CAIL TT,XHINUM ;XHINUM IS TYPICALLY >777, SO THERE'S LITTLE
JRST LXPRLZ ; CHANCE OF THIS SCREW, BUT BETTER BE SAFE
MOVEI A,IN0(TT)
MOVEI TT,(T)
JSP T,SPECBIND
0 TT,ARGLOC ;ARGLOC HOLDS PDL POSITION FOR VECTOR OF LSUBR ARGS
0 A,ARGNUM ;ARGNUM IS NUMBER OF ARGS, AS A LISP FIXNUM
PUSHJ P,(D) ;CALL THE USER FUNCTION, NUMBER OF ARGS IN A
POP P,D
SKIPN T,@ARGNUM
JRST .LCAF7 ;MIGHT AS WELL BUM FOR NO ARGUMENTS
HRLS T ;GOT TO GET RID OF THE ARGUMENTS
SUB P,T
.LCAF7: JUMPE D,UNBIND ;THIS EXIT SIGNALS CALL TO NOTYPE LSUBR, OR NCALL TO NUMERIC
PUSH P,D ;ELSE EXIT THROQGH FIX1 OR EQUIVALENT,
JRST UNBIJD 9 MEANING REGULAR CALL TO NUMERIC LSUBR
.LCAFX: PUSH P,CFIX1 ;PUSH ADDRESS FOR CONVERTIJGMACHINE NUMBER TO FIXNUM
AOBAD,.LCAF5 9INCREH ≥PAλA!¬'(A)!
Aπβ1_A)≡]→πβ1_Z`A]⊃∪π⊂↓
∨→→=+&~∀4∀]→π¬
_t∪A+'⊂A@Yπ
→=β(b~(∪β∨∃∧AλX]1πβ J4∀~∀]1ββ ∧h~∃ ∧⊂∪!+' A Yπ⊃¬_b~) ∧H∪¬∨∃αA⊂X]→π¬ j~∃⊃∧J∪→∃%$A7M∪1¬∪PA9πβ1_A)≡↓ ∨+¬1
S)3A
A+'∃$A→'U¬$C9t~∀~∀9→πβπ`t~∃π`H∪!+M⊂A Y
π∪!_D~∃π0⊂∪β∨∃∧AλX]1πβ J4∃π0J%→ %$↓7'∪1 ∪(A9
β→_AQ≡Aπ∨5!→ 05)3!
↓+' $↓→'+¬HC9:~(~∀]→
β 0t4∃ 0H%!+'⊂↓ Yπ U!_b~) 0H∪¬∨∃αA⊂X]→π¬ j~∃⊃0J∪→∃%$A↔M∪1¬∪PA9πβ1_A)≡↓ +!→∃0[)3A
A+'∃$A→'U¬$C9t~∀_∩∀vlrA)⊃∃'
A)!%
A→+≥π %∨≥&A5 % →dA'β-∀A)⊃
↓→∨' HA)⊃
↓)%∨+ →
A∨_A)3!%≥∞@EM !"@λ\~∀~)≥∨% Pt∪!+M⊃∀A 1≥∨)≥=(∩∩wM+¬$@D~∀β⊃I%5~A∧Y-≥∨I (~∀%!∨!∀↓ X~∀4∀]%'∃(t∪!U'⊃∀A@Y≥∨)9∨(∩∩m'+¬$b~∀∪5∨- ~↓αY,]I' (~(∪!∨!(A X~(~∃≥∨U+≡t∪A+'⊃∀↓ Y≥∨Q≥∨(∩$w'+¬H@b~∀%⊃%%54AαY-9∨++≡4∀∪!∨A∀A X4∀~∀~)'+¬)Q_∪-βI∪↔+&↓→∪')%≥∞Aβ9λA
5→∪')%≥∞A%=+)∪≥∃&~∀~)→∪'(h∪!+' A
1 1ππ!∨A∀∩∩w1'+¬$4∃→∪'Q0t∪≠=- ∩A∧Y≥∪_$∩w¬βM∪πβ→12XA)!
A
+9π)∪∨8@E→∪M(D~∀%'↔∪!8A$Y($∩vAπ¬→→ λ↓/∪)⊂↓αA!+M⊃∀A
a X~∃1∪')0Lt∩A∃U≠!
AHYπ!∨A1∀~∀%≠∨- $A∧XQ∧R∩∩w
→∨¬¬∃%&Aα1∧Y(YQ(Y$~(∪!∨ ↓ Yα~(∪∃' ↓(Y! 1≥≠⊗~(∪∃' ↓(XKπ=≥&~∀%β∨∃α↓$Y→∪M)0f~(~∃≠β-→'(t%∃' APY
1≥Xb~∀∪Q 5αA∧Yα~∀$A!+'!∀A Y91π∨≥L~∀∪'=∃∂
AQ(X\ZD~∀∪!=!∀A 0~∀~∀lvvA∪9) %≥L LISTING FUNCTION; EVALUATES A LIST OF ARGS,
;;; STACKING THEIR VALUES ON THE PDL
KLIST: HLRZ B,(A) ;SUPER-HACKISH VERSION
PUSH P,B
HRRZ A,(A)
JLIST: HLRZ B,(A) ;HACKISH VERSION WHICH DOESN'T
PUSH P,B ; EVAL FIRST ARG OR COUNT IT
HRRZ A,(A)
ILIST: MOVEI T,0 ;CALLED BY JSP TT,ILIST
JUMPE A,(TT)
PUSH FXP,TT
PUSH FXP,T ;CONTAINS 0 - USED AS COUNTER
PUSH FXP,R ;MUST SAVE R!
ILIST1: PUSH P,A ;OTHERWISE, THIS EVAL LOOP
HLRZ A,(A) ; MAY CLOBBER ANYTHING
PUSHJ P,EVAL
ILIST3: EXCH A,(P) ;SAVE VALUE ON STACK
HRRZ A,(A)
SOS -1(FXP) ;COUNT VALUES
JUMPN A,ILIST1
POP FXP,R ;RESTORE R
POP FXP,T ;T HAS -<# OF VALUES ON PDL>
POPJ FXP,
;;; JSP T,GTRDTB ;GETS READTABLE IN AR2A, AND MAYBE CHECKS FOR ERRORS.
GTRDTB: HRRZ AR2A,VREADTABLE
SKIPN V.RSET ;ERROR CHECKS IFF *RSET NON-NIL
JRST (T)
SKOTT AR2A,SA
JRST GTRDT8 ;ERROR IF NOT ARRAY
MOVE TT,ASAR(AR2A)
TLNE TT,AS<RDT> ;ERROR IF NOT READTABLE TYPE ARRAY
JRST (T)
GTRDT8: MOVEI AR2A,READTABLE ;ON ERROR, RESTORE TO STANDARD READTABLE
EXCH AR2A,VREADTABLE
EXCH AR2A,A
PUSHJ P,GTRDT9 ;GIVE OUT A FAIL-ACT
MOVEI A,(AR2A)
JRST GTRDTB ;TRY AGAIN IF LOSER RETURNS TO US
SUBTTL NOINTERRUPT FUNCTION
NOINTERRUPT: JUMPE A,CHECKU ;SUBR 1 - ENABLE/DISABLE
CAIN A,QTTY
JRST CHECKU
SETO A, ; RANDOM ASYNCHRONOUS
NOINT0: EXCH A,UNREAL ; "REAL TIME" INTERRUPTS
SKIPGE A ; (CLOCKS AND TTY)
MOVEI A,TRUTH
POPJ P,
;;; CHECK FOR ANY DELAYED "REAL TIME" INTERRUPTS, AND RUN THEM
;;; IF ANY. MUST DO THEM IN THE ORDER ↑G/↑X, CLOCKS, AND OTHER.
;;; NOTE THAT AFTER A ↑G OR ↑X, CHECKU GETS CALLED AGAIN.
;;; DESTROYS D AND F
CHECKU: SKIPN UNREAL ;NONE CAN BE PENDING IF NOT DELAYING
JRST NOINT0
CHECKQ: PUSH P,A
PUSHJ P,UINTPU
NOINT1: SKIPE (P)
JRST NOINT5
SKIPE D,UNRC.G ;PROCESS ↑G/↑X FIRST
JRST CKI2A ;TOP LEVEL OR ERRRTN WILL DO A CHECKU
NOINT5: PUSHJ P,NOINTA ;NOW PROCESS ALARMCLOCK INTERRUPTS
JRST NOINT1
NOINT3: SKIPG F,UNREAR ;NOW ANY OTHER INTERRUPTS
JRST NOINT4
SOS UNREAR
MOVE D,UNREAR(F)
TRNE D,400000 ;IF (NOINTERRUPT 'TTY), SUPPRESS
SKIPN (P) ; TTY INTERRUPTS AT THIS TIME
PUSHJ P,YESINT ;MAY CLOBBER R (SEE UISTAK)
JRST NOINT1
NOINT4: SKIPG A,UNREAL
MOVEI A,TRUTH
POP P,UNREAL
JRST UINTEX
;;; DO NOT TRANSFORM THE "PUSHJ, POPJ" SEQUENCES INTO "JRST".
;;; YESINT DEPENDS ON LOOKING AT THE PUSHJ ADDRESS TO SEE WHETHER
;;; WE CAME FROM NOINTERRUPT OR ELSEWHERE!
NOINTA: SKIPN D,UNRRUN
JRST NOINT2
SETZM UNRRUN
PUSHJ P,YESINT
POPJ P,
NOINT2: SKIPN D,UNRTIM
JRST POPJ1
SETZM UNRTIM
PUSHJ P,YESINT
POPJ P,
ENOINT::. .SEE UINT0N
SUBTTL CAR/CDR ROUTINES AND FUNCTIONS
;;; HERE BELOW FOLLOW THE "FAST" CAR-CDR ROUTINES,
;;; USED WHEN *RSET=NIL, AND BY COMPILED CODE.
;;; NOTE THAT THE RELATIVE DISPLACEMENT OF THE FUNCTION ENTRY POINTS
;;; IS VERRRRRY IMPORTANT TO THE POOOR COMPLR.
;;; DONT EVER CHANGE THEM!!
CARCDR: ;INDEX NUMBER FOR CALL BY COMPILED CODE
%CADDDR: SKIPA A,(A) ; 0
%CADDAR: HLRZ A,(A) ; 1
%CADDR: SKIPA A,(A) ; 2
%CADAR: HLRZ A,(A) ; 3
%CADR: SKIPA A,(A) ; 4
%CAAR: HLRZ A,(A) ; 5
%CAR: HLRZ A,(A) ; 6
JRST (T)
%CDDDDR: SKIPA A,(A) ; 8
%CDDDAR: HLRZ A,(A) ; 9
%CDDDR: SKIPA A,(A) ;10.
%CDDAR: HLRZ A,(A) ;11.
%CDDR: SKIPA A,(A) ;12.
%CDAR: HLRZ A,(A) ;13.
%CDR: HRRZ A,(A) ;14.
JRST (T)
%CAADDR: SKIPA A,(A) ;16.
%CAADAR: HLRZ A,(A) ;17.
%CAADR: SKIPA A,(A) ;18.
%CAAAR: HLRZ A,(A) ;19.
JRST %CAAR
%CDADDR: SKIPA A,(A) ;21.
%CDADAR: HLRZ A,(A) ;22.
%CDADR: SKIPA A,(A) ;23.
%CDAAR: HLRZ A,(A) ;24.
JRST %CDAR
%CAAADR: SKIPA A,(A) ;26.
%CAAAAR: HLRZ A,(A) ;27.
JRST %CAAAR
%CDDADR: SKIPA A,(A) ;29.
%CDDAAR: HLRZ A,(A) ;30.
JRST %CDDAR
%CDAADR: SKIPA A,(A) ;32.
%CDAAAR: HLRZ A,(A) ;33.
JRST %CDAAR
%CADADR: SKIPA A,(A) ;35.
%CADAAR: HLRZ A,(A) ;36.
JRST %CADAR
;;; THE FOLLOWING TABLE IS A TRANSFER VECTOR: GIVEN THE INFO-NUMBER
;;; OF A CAR-CDR OPERATION, SAY N, THEN CARCDR[N-2] IS THE
;;; ADDRESS OF THE FAST ROUTINE FOR THAT OPERATION. NOTE THAT THE
;;; INFO-NUMBER IS NOT THE SAME AS THE IN@EX-NUMBER-FOR-COMPILED-CODE
;;; ALSO, THE TOP 13. BITS ENCODE A DECOMPOSITGN OF THE A-D STRING INTO
;;; 1) THE LEFT-MOST OPERATION - 1 BIT (1 FOR "D" AND 0 FOR "A"),
;;; 2) THE INFO NUMBER OF THE "TAIL" - 6 BITS ("TAIL" IS REMAINDER OF
;;; A-D STRING, E.G., "TAIL" OF "ADDAD" IS "DDAD")
;;; 3) THE "BOY ARE THESE NUMBERS RANDOM" NUMBER WHICH THE COMPILER
;;; USES WHEN OUTPUTTING FAST JSP CALLS THE THE %CARCDR ROUTINES.
%CARCDR:
IRP X,,[A,D
AA,AD,DA,DD
AAA,AAD,ADA ADD,DAA,DAD,DDA,DDD
AAAA,AAAD,AADA,AADD,ADAA,ADAD,ADDA,ADDD
DAAA,DAAD,DADA,DADD,DDAA,DDAD,DDDA,DDDD]AD,,[0,1
0,0,1,1
0,0,0,0,1,1,1,1
0,0,0,0,0,0,0,0
1,1,1,1,1,1,1,1]TL,,[0,0
2,3,2,3
4,5,6,7,4,5,6,7
10,11,12,13,14,15,16,17
10,11,12,13,14,15,16,17]
zz==%C!X!R
AD←35.+TL←29.+<zz-carcdr>←23.+zz
TERMIN
ICADRP: PUSH P,CFIX1 ;+INTERNAL-CARCDRP
JSP T,IC.RP
↓ SETO TT,
POPJ P,
;;; SKIPE IF CARCDR FUNCTION, WITH CODE WORD IN TT
IC.RP: CAIL A,QCAR ;First
CAILE A,QCDDDDR ;Last CARCDR sym
JRST (T)
2DIF [HLRZ TT,(A)]%CARCDR,QCAR
LSH TT,-5
JRST 1(T)
;;; STANDARD INTERPRETER SUBRS FOR THE VARIOUS CAR-CDR
;;; OPERATIONS. THESE CALL A CENTRAL DECODER WHICH IN*RSET
3+; MODE PERFMRMS TYPE CHECKING ON THE OPERAND AT EACH SDEP.
CRSUBRS:
IRP X,,YA,D AA,AD,DA,DD
∃β¬αYββ⊂Yβ ααbε∩⊃d"ε¬2$
⊃2∩$ 2∩∩ h*εε 2εε !2εε$ 2εε$!2ε∩ 2ε∩ !2ε∩$ 2ε∩$ 4*∩
¬2∩
⊃2∩ "¬2∩ "⊃2∩$
¬2∩$
⊃2∩$"¬2∩$"∩tQ(2
B~' LU:∧∧2d:&hUHZ$lLaQ hS572∧dZD∧ k¬D∧#@,+λλ→Qλ∪λZλ⊂uk 6THλ((⊂(λ`i⊗aQ)⊂'h⊃i j$SβN, WIT@⊂~(rvvAQ⊃αA
¬%∪β¬1 &A.10Y2YhA%β≥≥∪∃∞A=-⊗I∧π2d
HObb∧HZB∧
jTl∀X∧@⊂∪αλ
∀vlp
α
*αε.⊗¬*R⊗⊃∧~6JJ-~B>:$J2:λIr∧≥ ≠%-∩λ~2∧4yID⎇tjH∧↓ ¬≥MNP ∞ = ∩@A4@Vα↓I↓↓α↓α&→¬92a2JαεJ∃∧rV2⊂hQ`≠[4 bβ@ "(∧∧λλ⊗%&H
` ⊂⊃P~λ⊂⊂⊂⊂∩c⊂#@,X ARE NULL
3 6lA≤@Z@@@@@A0TP@VA2(d@VAh@V@b@@@@A% A.A%&A≥ 1_~∀vlrA @tA.Tb@@VA0(h@VAdTd@V↓0@V@H`@@@↓∪ A≥=≥
A∨_A.Y012Y4A¬%
A≥U→_~∀lvvA≥=)
A)]≡A)⊃%≥∂&t4∀vvv↓6c:AQ⊃∪&AI !% M ≥)βQ∪∨≤A= AαA
β$[π⊃$A∨!∃%β)∪=≤A∪&↓ β'∪12~∀vlvA¬∪Q/∪'
↓ βπ∨⊃β¬→
8A)⊃
↓!∨'∪Q∪∨≤A= A)⊃∀A
∪%M(@bA ∪(~∀lvvA∪9 ∪πβQ &A)!
A' ¬%(A∨_A)⊃
↓% '(↓∨ A)!
A ≥
∨ ∪≥≤XA/⊃%π⊂A⊃¬&~∀vlr@`A→∨$Aπ¬$X@b↓
∨$A
$AβPA βπ A!∨'%)∪∨≤8~∀fVlA6e:↓
∨$A¬≥2A'∃(A∨ ↓≠! %¬)∪∨≥LAπ∨≠A→ )
↓
%∨~↓ββ$A¬≥Aπ⊃$X~∀lp
mα$BJ>V<Aα∞ε
⊃1α∞ "I1↓rq9αRz↓α2⊗4*1α5∩α≤
%X4%∩z4αE$ z4*¬y~D@H'33J∧β(⊂$zh⊂3HD⊃ te∃λ∃∩ ~h⊃3H9q∩3Ht∀⊂ 'Q*abiH P!gSh ajλ"g!gQ$g#FβE≥P≠; ↓ M+1¬
;;; GITH NRANGILC FROH
@DααR=↓∩↓↓↓5
α&*∞e*N&Z*p4)m[X4)M[Y↓α: j∀%αr↓">∞$
1$&p∧αD∀→h∃∃J⊃Q#K[4∧α∧≤~!∩ααε!⊂Jα∧ε∪@"NngP⊂⊂!Q)P⊂λ→DDPλ⊂_XFB≥]]Pλ⊂!``T∧P⊂⊂
∧@P⊂ X_εE∞]]P⊂λ!`b)αP⊂⊂~BDP⊂_L_BE≥N]P⊂⊂ ⊂↔⊂↔βE_ ;; CDDADR 3% 111⊂1
;≠8ε@@A
∩∩
⊂%↓↓≠0$%E E@4SYem↓αα∞∩∩$"H%↓β→\$¬ EEDhP4(∀P04λhR∞IAPJN.&∧)αY:∃~⊗P4PIα*J≥!α∞Iλh(&B⎇↓αA2 h(&*∃~Qα↓,~εJ∞%⊃5r∞∃~V
J~YEy"2H%nF,J∞-α4*JNε|qα~>∩↓*JN-!↓uαtJ04(hR∞IEPJBVNDQαA2≤
ZaLHIf∞≡mα&"⊗"αε.∩*αεNN,j⊗Mαu*6ε∞~αNε~(h*∞I h&6⎇2⊗%α"a"¬$hQ↓↓↓∀"&→α\j>Z⊗JαQ1"2Ju@#εεββ∩H:%≥,**2[λ↔6Cββεεα∧M4λd⎇∩λ8∩t$Z!PT≥&' M≤9zE"∧EIE_H↔84D 94∧4⎇$ DM≥D
EM∧QQ J∧**5"∧:&@hT:"3PMJ)dr¬EF⊂HK:94Mα _b∧≤J$∧m∧Z(∃$LyaPPJ *%≥"λ:#≤⊂Q!∀E∃+$∧"bλE⊂hT:&4 P~)u"¬EESλh!~E∀tT
Bc;va⊂K]99∃α∧_d∧ dDλD|tQQ J∧**5"∧:& hT:&sPLYzd,Jλ∃BD"⊃Q LU*:B¬∃:Kβ_H↔84|m →D,"λ9t$*λ~5≥,XZ2∧uYX∀≥~
8∀4(Q!PT≥&8#PMIId*¬JEDDt1⊃∪\Ld ∃%~λ∀∧E,i5B¬$λYb∧≤~$∧D Dλ$-%HZ hP∀ %∃≥Dλ5∪≤1Q LDJ+"∧"EλBHH↔:D \T
DD
λ8∃⊂h!→%∃≥Dλ5∪≤⊃Q$≥∪87 LDJ+"¬%EE∧"HQ!∀ →d∧"bV⊃⊂K\izB∧∀Tλ∩¬,jZ4,"
9D⎇ Q!∩∧U*:Bαr61PPJ∧ T⎇4TλBe%AQ Jα *%≥"λ:#≤λQ!∀l⎇hY∩∧
EλBHh!~¬-≤ $¬αeyI∧-∃!Q LlzhTJ∧EE∧
HQ!∀U∃:D∧≥∪!Q hT:&CPMJ)d*¬EF⊂HK9_b∧t[
B∧
(t∧M≤dzB∧
I∃≥ Q!∩¬≤9~∧
¬%Jd≤%!⊃∪]$λYb∧≤λX4Z∧zZB∧ x→∀u≥D
∧-∀Y~5≤L)I∃$LZ1PPJ∧ T⎇4T
"e48~ hP→*Tm∧d
"d≥&QPPMJ)dr∧EESλH↔9∀2∧yiEJ∧i→B∧ hD∧dM:J2¬∧Z)TM≥9_$d(Q!∩∧U*:B∧≥&q⊂K]IλTr∧HZB∧t→D∧∀,9yT*∧i→BαD8~"∧t→E∩βj¬λ4%∩ i∀bJπP∧dLAQ LU*:B∧≤∃hD-⊂⊃↔4,e8UB∧∀yX"∧⎇ZAPPh(:#+P_8∀L*
%E
≥→X$|`Q!∩∧U*:B∧≥&aPPMJ)d*∧EESλh!∀¬$dhT¬%"J;⊂hP∀∧∧U∃:D∧≥∪1Q LU*:B∧≤∃hD-⊂⊃↔4d⎇8T∧L2 hTM$λZ"∧t→D∧t⎇$
5Ll)y@hPQ(5∪3!_4 Ld
"e I~5 h!∀∧U∃:D∧≤
hHU⊂H↔9DM≥D
D-≥D tr∧~(r∧D~4∧ e(X∀%Jλh∀LdXEB¬≤tλd LAQ LU*:B∧≥&1⊂K\_d∧≤
%H4%∩ iu"α)I∃≥"%Dα∃≥→X$|b%D∧⎇∩∧)dLb%APPH⊃⊃∪Z¬IλTr∧y4∧4⎇$λ∀uMI ∀t8Q `h!Q#[[4 e$B ≥f"∧jI∧≤%$¬RεNd¬%∃≤ZDεO~
|f2b∞N'JπMtε&z l↔∨&O∀hPQ'2αDjIα∧rλitzJ
(U%-)j2¬$λT∧u$∧λ4
∩ :tD-(TαDuI∧βα∧iyrJ∧~4αD≤~$∧4|u≠PhS4↓∩αα∧∧α∧-~Y∃4 HYe"¬ItαD≤~$αDuIλ4%∩ d∧4|u∃⊂hS4¬∧u$λ8E∩∧dλd|z∀
$-%Z)e~¬IλR¬∀Z:Te" xbα<dt∧≤%$z0hPQ!PTuIπ M$K(∩¬∩J!PTuIλ4%∪!→T⎇4Y∀¬∩eJ*U$@⊃↔5∩∧~4α∀uIλ4%∩*∧∧4d_tαjα¬∀βkkd∧$u$∧!PTuIλ4#+!~4\M d∧"eej%≤-AQ J∧**5"∧jI∧≤#aQ Jα
94⎇%Dλ∩d5↓Q Jα∧ %∃≥D e$D_Y`hTjI∧≤#g!∀l⎇hT¬%"Eλ∩Hh!→%,m HR¬%EIe$D8FK\ZZ5"∧(T∧t|eYd,<~I∃4(Q!∀-D9∧∧
d!⊃∪]∀Z:Te"
Ir∧∀T
$-%Z)d," →b∧λQ!∀U,Z b∧"IjDD≤F!⊂KZ**4-"πWSr∧It∧-∃)z"∧≤λX4Z∧yd∧, 9∧∧,dYXTu Q)e$D8F∪PL
*%R∧∃E∧
H⊃↔4$zλ∀∧≤%!Q M≤y(r¬%EIe$D8F⊂HK9It⎇α
Ye$LDλ∃¬¬)z¬∀L~HR∧uYX$-∩ xb∧≤J$u~∧Iyd(h!→%,mλT¬∩bH8∃⊂h!~∧⎇∧$
α`H⊃↔5$DYd¬∀-JZ$ph!Q$u$λ8CβP→*Tm∧d
E"djI∧L,a⊃∪\LhHUBα&∧ hP_[∧≤Bλ∃D⊂h!→%,m d¬∩d: u∧P⊃↔4U-:D∧-D~D∧4⎇$ e$D8J hP→*Tm∧TλBb$8~ HK8(T≤|XTα∀≤~$"∧4z$αDuI∧βᬬ⊃PPL**5"∧8~ hPQ!PTuIλ4#∪!→T⎇4TλbbD%⊃PPM9z2∧0Q!∃¬-9 "¬αIH∃≥$91⊂K]H→4*α%λbJ∩λ8E∃~D
4\M∧ ∀2¬:X4≤-:8e,`Q!∩∧U*:B∧uIλU⊂H↔4∧-∃)z"∧Ldλ∃∀:V∀∧≤%*4∧M~λ~D|l_1PPL*YU∧r
%Du$λ8C h!→¬∃∃$λBbDE⊃PPM99u%"λEDe_Q!∩∧UYZ∧r∧EIe$DZ!PPL J%R∧∃E∧"H⊃↔44⎇$∧$u$∧!PPM z∧R¬¬APPh)jDD≤FG LE*+"∧
EλBHH↔8d⎇∩∧)e$D8J"∩b
H∀\*λi∀t Dλ4%⊂Q!∃∧⎇ $¬α`Q!PP`h*:T∃%IA∃≥LX)tb∧9ye≤-!Q hU htt[!_∀$$∀λ2e∧h*T2k⊃⊃∪\|iK∩∧∃∀ ∀u$Z)bαj
U∀Li_U~¬ h∀l* _b¬∀YHU4 jAPPM99∃∧<T E∧ta⊃∪\Ld E∧td ∃~∧hXt
$~hRb¬IλR¬∧h→T*∧~4∧Lr
d∃,eAPPJ
U≤D$
αe∧h9tu_⊃↔2¬≤t
t*∧9ye~∧~D¬-α iu8h!~4\MλT∧∩eej¬-∀QQ J∧8→∀r∧%J∃≥LX)t`h!∀α∧U*:B¬≥_9tu_⊃↔4tz
U∀*λ9u¬J hT,$XEB∧UZ:B∧≤yj2¬-∧
5Ll)y@hP~
U≤D$
αe¬Z(4⎇¬⊃⊃∪\,J8R∧<ZD¬¬-(T∧≤⎇ ∀∧|2
d lQQ LU*:B¬¬;_4|u1⊃∪\ hD¬-≤T
¬-∀Tλ4|u8Z hPQ*∧t<i6∪PM99∃∧<T E∧ta⊃∪\≤yj2¬-∧
∧t XT∧L2 hT≤-:8∃∃HQ*∧t<i6#PJ
U≤D$
αe∧h9tu_Q*5L≤yj3PH⊃⊃∪\≤yj2¬-∧λ∩¬≥→X$|b¬T¬∧t→XR∧d~:B∧M4 ∀r∧⊃Q"ααλ(∀]¬)qPPM99∃∧rλheHH↔9∀2¬;→T∀|Dλe∀,YI∃≥"λYU¬%∃D∧<zλIr∧
λx0hP∀ %∃≥D
5L≤yf⊂hP~94M∧dλ"d4k⊗ HK9_b¬≥→X$|bλ)D|≤4λe∀,YI∃≥"λYU¬%∃D∧m-:D∧<_Q!∩∧U*:B¬≥_9tsλQ!∀l⎇hYR∧
J;∀m∧h→T*D%⊃∪]¬ZD¬∧t→XR∧Ld
5Ll)yB∧∀Ix4Xh!→T⎇4Tλ∩e];∃d|tUEE≥,h)u,tKTβ\Li~DL D
d eXT∧≤,ID∧M~
:Tt∀zYd h$∧α¬D:J¬∀xQ!∀-D9∧∧
e;→U4~λ%⊂HK:
U"∧→d¬≥LX)tb∧)It≤XQ!∀l⎇hYR∧
HheK⊂⊃↔4≤%$
5Ll)yB∧∀Ix4Z∧j(T,d~:@hU;_4|s'!∀l⎇j9∩∧
Eλ"HH↔9∀tMI_∀b¬
)u∧-*K∩∧d~:B∧M4 dL`Q!∀-D9∧∧
dλheHH↔84|u4
Uα¬;→T∀|D ∧, HZ hP_[∧≤Bλ∃D45⊃⊃PRα∧ d⎇¬)qPPM z∧R¬¬APPh$∧α¬≥λX5¬∀t ∀u%;≠hU;_4|s↔!∃¬-9 "¬αH_t_h!→%∃≥D
5L≤yj0hPQ'5¬-(T¬≥LX)tb∧9ye≤-!Q%¬≥_9tu≠!Q$∀ :
$xh!_∀⎇≤Dλ"duλheK⊂⊃↔4≤|j4¬-αλ∀¬¬-(T¬≥LX)tb∧)It≤XQ)d⎇¬)qPRα∧
5∧,:
$z∧→jE≥M⊃Q J¬
Z4DR
¬D=$j
48h!_∀$"λ%D-∧hk∪⊂h!_∀⎇~ j∧45⊗!PRα∧
5∧,:
$z∧→jE≥M↓Q LlzhTj∧∃J5Lm h∀l*λ%⊂hP ;SY.PUR BIT SAYS MAYBE READ-ONLY
MOVEM A,SYMVC(B)
BAKPRO
SKIPE FFY ;IF SYMBOL FREELIST EMPTY, GO DO A GC
JRST SYCON2
PUSHJ P,AGC
JRST SYCON2
NOPRO
PNCONS: PUSH FXP,T ;CONS A PNAME LIST OUT OF PNBUF
MOVEI A,NIL
2DIF [MOVEI C,(C)]1,PNBUF
PNG2: MOVE B,A
MOVE TT,PNBUF-1(C)
JSP T,FWCONS
PUSHJ P,CONS
SOJG C,PNG2
CPXTJ: JRST POPXTJ
SUBTTL LIST SPACE CONSERS
;;; THIS SET OF CONSERS IS USED WITHIN THE LISP SYSTEM.
;;; ONLY A AND B ARE CLOBBERED, AND THE ARGUMENTS MUST NOT
;;; BE PDL QUANTITIES.
;;; FOR NCONS, SEE JUST BEFORE "ACONS"
;NCONS: TRZA B,-1 ;(NCONS A) = (CONS A NIL)
NXCONS: MOVEI B,NIL ;WILL "PUSH" A () ONTO A LIST IN A
XCONS: EXCH B,A ;(XCONS A B) = (CONS B A)
CONS: HRL B,A
SPECPRO INTC2X
CONS1: SKIPN A,FFS ;SKIP UNLESS FREELIST EMPTY
JRST CONS3
EXCH B,(A) ;PUT POINTERS IN CELL, GET CDR OF FREELIST
XCTPRO
EXCH B,FFS ;CDR FREELIST, COPY OF CELL POINTER TO B
NOPRO ; (BUT NO ONE CURRENTLY TAKES ADVANTAGE OF IT)
POPJ P,
SPECPRO INTC2X
CONS3: HLR A,B ;DO THIS TO PROTECT POINTERS FROM GC
PUSHJ P,AGC ;PERFORM A GARBAGE COLLECTION
NOPRO
JRST CONS1 ;GO TRY AGAIN
;;; THIS SET OF CONSERS IS THE SET AVAILABLE TO INTERPRETED CODE.
;;; THEY MAKE SURE THAT PDL QUANTITIES DO NOT GET INTO DIST STRUCTURE.
$NCONS: MOVEI B,NIL ;SUBR 1
EXCH A,B
$XCONS: JSP T,PDLNMK ;SUBR 2
EXCH A,B
JSP T,PDLNMK
JRST CONS
LIST.: AOJG T,LIST.9 ;LSUBR (1 . N)
POP P,A ;(CONS A B C D) = (CONS A (CONS B (CONS C D)))
PUSH FXP,R ;THIS ROUTINE MUST SAVE R AS COMPILED CODE COUNTS ON IT
MOVE R,T ;LISTX3 WILL WANT COUNT IN R - ALSO SAVE OVER PDLNMK
JSP T,PDLNMK
PUSHJ FXP,LISTX3 ;LISTIFY ALL BUT LAST ARG,
POP FXP,R
POPJ P, ; WITH LAST ARG AS FINAL CDR
;;; THIS SET OF CONSERS IS CALLED FROM COMPILED CODE.
;;; THE "CDR" MUST NOT BE A PDL QUANTITY; THE "CAR" IS PDLNMK'D.
%PDLNC: TRZA B,-1
%PDLXC: EXCH B,A
%PDLC: CAML A,NPDLL ;VERY FAST CHECK FOR A PDL NUMBER
CAMLE A,NPDLH
JRST %CONS
PUSH P,T ;IF PROBABLY A PDL NUMBER,
JSP T,PDLNM0 ; IT'S SO SLOW THAT THIS PART
; DOESN'T MATTER SO MUCH,
JRST CONS ; BLETCHEROUS IS IT IS
;;; THIS SET OF CONSERS IS CALLED FROM COMPILED CODE.
;;; ARGUMENTS MUST NOT BE PDL QUANTITIES.
;;; THESE ARE SLIGHTLY FASTER, SINCE T IS USED FOR JSP.
;;; FOR %NCONS, SEE JUST BEFORE "ACONS"
;%NCONS: TRZA B,-1 ;(NCONS A) = (CONS A NIL)
%XCONS: EXCH B,A ;(XCONS A B) = (CONS B A)
%CONS: HRLI B,(A)
SPECPRO INTC2Y
%CONS1: SKIPN A,FFS ;SKIP UNLESS FREELIST EMPTY
JRST %CONS3
EXCH B,(A) ;PUT POINTERS IN CELL, GET CDR OF FREELIST
XCTPRO
EXCH B,FFS ;CDR FREELIST, COPY OF CELL POINTER TO B
NOPRO ; (BUT NO ONE CURRENTLY TAKES ADVANTAGE OF IT)
JRST (T)
SPECPRO INTC2Y
%CONS3: HLR A,B ;DO THIS TO PROTECT POINTERS FROM GC
PUSHJ P,AGC ;PERFORM A GARBAGE COLLECTION
NOPRO
JRST %CONS1 ;GO TRY AGAIN
;THIS ROUTINE IS FOR COMPILED CODE. IT DOES A PDLNMK CHECK ON BOTH ARGS
%C2NS: PUSH P,T ;ALLOW RETURN VIA PUSHJ
$C2NS: EXCH A,B ;WE CAN USE $XCONS, BUT IT WILL ALSO DO AN EXCH
JRST $XCONS
SUBTTL NUMBER CONSERS
FIX2: JSP T,IFIX ;FLONUM TO FIXNUM CONVERSION, FXCONS, POPJ
FIX1: POP P,T ;FXCONS, THEN POPJ
FXCONS: ;FIXNUM CONS - MAY UNIQUIZE
FIX1A: CAIGE TT,XHINUM ;IF WITHIN THE RANGE OF THE
CAMGE TT,[-XLONUM] ; BUILT-IN TABLE OF UNIQUE FIXNUMS,
JRST FWCONS ; THEN NEEDN'T DO A REAL CONS
MOVEI A,IN0(TT) ;JUST PROTIDE A POINTER INTO THE TABLE
JRST (T)
¬
S@ECPRO INTZAX
FWCKNS: SKIPN A,FFX ;FULL WKRD AONS - ALWAYS COH
' L~∀αA)' Aα1β∂εh4∀∪ 1
⊂A)(0QαR~(@@A1
)!%≡4∀∪ 1
⊂A)(1
0~(@@A≥=!%≡~(∪∃%'P@Q(R4∀∩∀~(~∃
→
≠⊂~aPJε>
λ∧¬"diH4l@Tb"'_S⊂siJh⊃r*Iλ∀ri~λ⊂Q*J4SC!! QS x5 NA→Ttλ
E⊂1S X5α"'8R6∪JY(⊂
'H#&'g∃fV⊂#∪!gg)K⊂('h∩εE#&∪`j_]αh'h⊂∀⊗*∧DB]c&!Se)V⊂∃$"g⊂∀'h%εB⊂⊂⊂)T ah)∪P g*⊗ hεE⊃&!gg∀]∧DDB]c&'S*fP!Se)FE⊃(!gg∀]∧ieRh'⊂ K!#&εB∧P%)T⊂ V QaZεEαbl!dλ**⊗∀⊂TFE⊂λ⊂,!j∀)'FEαbl!dλ**⊗#⊃&εE⊂λ⊂''h∀'FE∧R))j⊂
*∀FEβε@
IFN DBFLAG,[
DBL1: POP P,T
SPECPRO INTZAX
DBCOLS: HRRZS FFD ;DOUBLE @RECISIOH Aπ=≥' $4∀∪'↔%!≤Aα1
λ~(∩A∃'@AαYβ≥εh~∀% 1π⊂↓)(XQ∧R~∧@A1π A%≡~∀% 1π⊂↓)(I
→λ∩∧@A≥∨!I≡~∀∪5∨% ~↓λXbQ∧R~∀∪)%'(@!(R~∃t∩∩w 9λA∂ ↓∪
≤A⊃¬
→β≤~∃∪
∀A ¬
1β∞Y64∃ ¬π=_
MhMαVN!¬↓2P4T"
1EPJ6.Z,Iα¬2 ">F
d($%n-∩J>I∧J→α∩⎇*
2⊗~α:>Q∧J6B2,j⊗:R, 4(¬,2ε
αu*5F6_h*t$KZ⊗ 4D t2∧_hR∧$(iD 8Q!PPh)_dr∧;λdd uK0hT9λ4luπ!∀ |(⊂¬"d;λ4|U1⊃∪L≥λ9tu~
y∃$B
94Mα
(U%-)aPPh(9U∧c↔!∃∧⎇∧
αe Q$αα¬:λT≥¬)t∧LUK(∃@h(;∧≤\j7 LE*+%~∧hh0HK89tm∧H[α∧uYX$-∩λ9te≤Z!PPM99∃∧rλ∃D441Q J∧*:α∧
H_t≠ Q!∀-D9∧¬%"Eλ∩Hh$∧α¬D:J¬∀xQ!∀-D9∧¬%"Hhd_h$∧α∧tz
$xh!→T⎇∀YT∧"c∃λ∩Hh!→%∃≥D¬¬"HQ+PHK8Yd"∧xd∧L4dλ5D4H_phT_hR∧≥λiD :K1PT≥λ9tu≠!~¬-≤∧
αe Q(4m∧F↔ LlzhTJ∧∃J∀≤|Z D-@↔8U∃∀z$∧M~λ9tm∧H[α∧uYX$-∃4 d⎇" →U∧dYXTu$XAPPJXh∀~∧jYS m1Q%hH↔8Tt" xb∧LhT∧≥DiH∀8h!Q hT_ib∧%λiD :K1PT%Z C P~ uᬬJ@hR∧∧¬≥∧X:¬∀z →e%T≠↓PT%λ9te≠!→¬∃∃*4∧45!⊃∪\$zX$d*Z
$,≤~9∀|Rλ9tm∧H[α∧uYX$-∩λ9te≤Z!PPM99∃∧rλ⊃D45!Q J∧*:α∧
H_t≠ Q!∀-D9¬∩bλ∃⊂hR∧∧¬D≥J
$xh!_UD≤∧
"d4i!PRα∧ d⎇¬)qPPLYzd,JλeC
D∃⊃PT\⊃→T⎇4YP¬%"F%∧
HQ)4λLYzd,jλEC~D∃⊃PT\→9@L$Yzd,jλJBc∩λ∃⊂hP→*%≥"¬
BHh+Q⊂K\YhB∧|d ∀4rλK∧4d_qPTLhT∧%DiH∀:e1Q$%D9ye≠P~
U≤B
¬E h(JU∧c↔!∀l⎇hY∩∧
J_E-∧H[HK8Z%∀⎇$ ∀2∧JZ∧dL8Z2∧tzD∧Lm HTl,jHT h!∀T4 4 e,k→Z0hUQ⊃∪\,hD∧|2 _d*∧Kλdd qQ `H*:T∃%IA∀E,i4¬¬∀→Y∃$MhZ2αjλ;¬∩b
*∧d ;↓B∧EYi3dseD∧E,i5B∧EYi4L5⊃Q hPQ)∀4* d\dxuEXh$Y¬,t6↔ hRY
Tt['!PR,
Yd[≠!Q",EYi3#PQ$T≥E'!PR-* βPLHZ%∩¬:9∃D∀~D¬dtt ¬,t:4∧Lr
I∧M~ I∃≥α¬T∧E,i5t≥E%z%∧d_;α
eQQ%hH↔8Tt" xb∧LhT∧Dt9It8h!Q hT_ib∧Di9D|:K1PPh(;¬∪P→*5α¬EHeDuf⊃⊂K]:X%∩β!Q M≤9~∧*¬ej%≤-AQ J∧*:α∧2H;¬∪_⊃↔4≤DX92∧
(z0hP~)u"¬JEBkλQ!∀ $I∀¬%"Eλ"Hh!→%,mλxR¬%EH5E∪!Q LDJ+"∧
E
E"H⊃↔4|$EYe,l(Z$,"λ9tm∧yhTu%4 ∀r∧HXe"∧λ→E4-1Q M∧z "¬αAQ hT;
#∪P→
%∃Rλ∃BE%E⊃⊂K\ZhTrljYT∀-(XB∧≤yZ∧|tYjE~∧→d¬∀Ly
B∧D→Jd-_Q!∃∧⎇ $¬α`Q!PPh**∧d ;β LU:∧¬"dk e3λ⊃↔5≥,*$β_h!~4\MλT¬2u*8U h!∀∧U≥∧λbd≥
&0HK89∧,≤4λ∃∀=1Q L≤→YB∧~Ij∧$dAQ L≤→YD*∧5Ie∧$I↓PPJ *%≥"¬e3 h!∀αα∧[λ4B∧ JSP T,PDLNMK ;SIGH - MUST PDLNMK THE DATUM
EXCH A,C
ROT TT,-1
ADDI TT,(B)
JUMPGE TT,RPLX2
HRLM C,(TT)
JRST BRETJ ;RETURN SECOND ARG
RPLX2: HRRM C,(TT)
JRST BRETJ
CXR30: TLNN T,$FS+VC ;A LISTCELL OR VALUE CELL IS OKAY
JRST CXR31 ; IF THE INDEX IS 0 OR 1
JUMPL TT,CXR33
CAIG TT,1
JRST (F)
CXR31: EXCH A,B
PUSHJ P,WLHERR
EXCH A,B
CXR3: MOVEI T,(B) ;CHECKING ROUTINE FOR CXR/RPLACX
LSH T,-SEGLOG
MOVE T,ST(T)
TLNN T,HNK ;SECOND ARG MUST BE HUNK
JRST CXR30
MOVEI D,2
2DIF [LSH D,(T)]0,QHUNK0
CAMLE D,TT ;FIRST ARG MUST BE SMALLER THAN
JUMPGE TT,CXR34 ; LENGTH OF SECOND, YET NON-NEGATIVE
CXR33: WTA [BAD HUNK INDEX!]
JRST -3(F)
CXR34: MOVE D,TT ;EVERYTHING IS APPARENTLY OKAY
ROT D,-1
ADDI D,(B)
HRRZ T,(D) ;FETCH COMPONENT IN QUESTION
SKIPGE D
HLRZ T,(D)
CAIN T,-1 ;ERROR IF AN UNUSED COMPONENT
JRST CXR33
JRST (F)
WLHERR: WTA [INVALID OR WRONG LENGTH HUNK!]
POPJ P,
;;; IFN HNKLOG
;;; CXR ROUTINE FOR COMPILED CODE. HUNK IN A, INDEX IN TT.
%CXR: ROT TT,-1 ;QUICK ENTRY FOR COMPILED CALLS
ADDI TT,(A)
JUMPGE TT,%CXR2
HLRZ A,(TT)
JRST (T)
%CXR2: HRRZ A,(TT)
JRST (T)
;;; RPLACX ROUTINE FOR COIPILED CODE.
;;; HUNK IN A, DATUM IN B, INDEX IN TT.
;;; THE DATUM IS GUARANTEED NOT TO BE A PDL QUANTITY.
%RPX: ROT TT,-1 ;HUNK SUBSCRIPT IS PASSED IN TT
ADDI TT,(A)
JUMPGE TT,%RPX2
HRLM B,(TT)
JRST (T)
%RPX2: HRRM B,(TT)
JRST (T)
;;; %HUNK1, %HUNK2, %HUNK3, AND %HUNK4 ROUTINES FOR COMPILED CODE.
;;; THESE ALLOCATE HUNKS OF SIZE 1, 2, 3, OR 4 SUPER-QUICKLY.
;;; ARGUMENTS IN A, B, C, AR1, GUARANTEED NOT TO BE PDL QUANTITIES.
%HUNK1: SKIPN VMAKHUNK
JRST %NCONS
MOVEI B,(A) ;%HUNK1 IS %HUNK2, WITH ONE ENUSED @π∨≠!=≥ ≥(0~∀∪≠=) ∩A∧XZb∩$p
α
-!αV:4zJRVt
R⊗2Jα6VN"αN"V422∃α
∩≡L4PJ*JN"↓⊗"VtYH4(hQ⊗":Y∩¬h&E∩JjM∧2~ $KZ"V:[!α&M¬""* →U∧⎇*H∀u"λ8∃≤(Q!∃¬-9 "¬αH_t_h$∧α∧∀→:¬∀xQ$TE,i6#@M99∃∧rλiT \
YdXHQ!∩∧U*:Bα 9ye_h!~4\Mλt∧44↓Q J∧**5"αY d[∀⊃Q LE)D∧∩d⊃Q L-λ9α∧∩Hλd4@Q$αα¬λ:E¬∀qQ L-λ9α∧∩Hhd@h!_UD≤∧λ∩d⊂Q$αα∧iz¬∀xQ!∀U∃:DαE"⊃Q hPQ$TE,i63PLYzd,Jλ~#
bλ5⊂HK9
Tt[4 ∃~∧*Z5"∧
Yd["D
tM$∧ tt*
Ye-≤XD∧ |Z tt,jAPPLYzd,Jλ5Bkλ⊃↔2∧∃Z@¬,tiz%%,h~D,e∀ U-≥D
4E,hiD*∧~(u_h!→%∃≥D∧TE,i6@hPβ"C!$2∪RfH.B2
*VThλhR
d!⊃.r∃)Imλ∩*4∃∩⊃$ 34∪j*⊂3U∧λp4q!QB4∃*9⊂H∀¬H1pc!$λλ⊂H→t∀SaQI2∃)im∞B*9r4⊃dλQR
f⊃"B( *Tu∧Y∪Rmλ⊃"B2
)λ⊂4F∃⊂#"A_4⊂r∧λ4L#λλQR
f⊃"Hλ∧ ⊂q∀
)c"B([⊂rλ~L+⊃Hi
l#!!16⊂i∧⊂+⊂*&#"B)
TVS$λK *λ∃#"B)
S∪ λ5 *⊂%⊃ Hλ∧ St∀Iq"B2J*uλ
E#"C!'nh⊃M}H≥X.-;⎇<d
:<xd
_8zn4≠yH
(14h ≥Yλ∀JykHλλ←_z_-ly(~∞]Zh_-lλ⊂+AQNnh ⎇[≡(
\:y<d∞y;\lT~;H∞l<↑(∞>≤X;L|(~_-l 8{lL+C"I_SH∃*83⊃4j5⊗c"AQI2∪I:P.B)
TVTdλQR
f⊃ (λ∧πpY(∞><Y(∞=9{H -=λ∩.∀≠yYAQB4∃*9∩H∀¬H1pc!$λλ⊂H→t∀SaQI2∪I6∀NB*9r4⊃dλQR
f⊃"B(∧ TTu∧∧2∪Rj(#"B([⊂rλλ∃⊂⊃QI¬l""$∧λ∞t
≤zh≥.∧≤⎇~,=|c"D∧λ⊗⊂jJ∀Sc!!16⊂i∧⊂+⊃Hi
l"!∀λλ∞h∀ /H ∞9Zh∞⎇=~λ
⎇→λ⊂m⎇]→;NNh≠qDλ#"H∧∧∪St
)c"B)*Tuλ¬
#"KQ"@↓A"Nng121SD ∪Rs xc"C!)∪Rtk&∞B5jH(⊗sIzλ⊂(
3Rh¬T∩∃3I:r6Q$≠#"B)*Tuλ RtvF⊃"R∃)itr6HWB""':u0TDε( ( hp3∪λ_S⊃#!!4∃4i∧∀ ⊂hi6 #!)∪Rtk&.B3)zQ2(
E
⊂*!QB3∀i∧∃ *81s∪hq"B4i94∪λ
E∀u
E#"B$ TTu∧ ∪Rtk&β"B)YuQ2$
∃ AQB5∪ h(∃ Rc"A∀∩TTjD Jm↓QB(λ∧
rr4 d∃S0)9∃3RaQ@(λ∧∧∀∪t $∀ α!↔tP3HIs(⊂iyTq4dλ4Q( xH∀r+(( C!!(λλ *Tu RtvF↓ B3)zQ2(λE #"D∧λ Q _H∩s
9⊂h∃
E
∃
+V ∀2
YRlβ!!01⊃ ∀⊃ &∃⊂*#!)⊃Rtk&nB4hZ⊂s
%
⊃
!⊃.su λ4Ur*8(⊂p)Hu3⊂*H(∪⊃)hu∩β!!5∪∪HT∀K &⊃"B(
t∩H
¬β"B*JSQ(
% ,#!!(∀si((∃∃¬Ht∪t !"B4jXR(⊃¬F#"B*:0R(
J C!!2U3*λh∃∃¬I∪Rtk&c"B*
4r∩D
∃s λ4TC!!2TTjD∩∪Rj;L#"AQR∃3I:∞B3
9λ⊂+¬Zq1s xb".j:0THε⊃"B4i94⊃q$λ+∀u¬λ*#"A∀∃∪∪Id⊂+∩ ic"B$∧∩TTjD⊃P3
8#"B)*Tuλ
JU1#!!"C"IY∃3RhWB5uλ∀⊗s5*:λ⊂Q$ ∩4u∧ tH⊃I≠∪U3$¬(∪0)9∃3Rd≠#"S(→r∃3I7B4riz∃λ⊂%HVα"':u0TDε#"B$ TTu∧ 2∃3I6#"B*9r4∪D
∃
λ∃#"B$ TTu∧λP3∀hQ"B3)zQ(∃¬J∃β"A~∃4r $∀ ⊂)I∃3Ra⊃.r3I~∩03 ≠Q1λ
Ih∪R)A"S2
YRmnA→∀r⊂d
,!⊃.s⊃(~Q4h
I⊃(λIx⊃∀λDλR5λ →H∀r(yH∪qD
∃β"A→∀S∪i∀∃ &∃∃
"!↔tq1$ ⊂2s(Y(⊃Sj$∃∩∩*4⊃45I∀∩⊂2aQB14*i(∃ ¬λ*#"A~∪∪SD
,!QB(∩J*uλ∪)
3RmAQB4q*KS(
E#"B(→pRSD
K&⊃"S2
YRmNA~rr4λx(∃∃↓QB(∩ I⊗Th¬
#"A~∪t∩D
β"AQC"C!)2∃3I6.B2JY4⊃q$
∃ ∪)
3Rq!∃Tq1$ ∀c"A→Ttλ
J ⊂4ε!".tjH0rh I4uλ yH∀⊃ Eλ 0iz3Uλ →H∃β!)∃3Rg!33uId∃∃
A".s
:0TC!!03rHt∃ ⊃H→∀q"!↔ptQ(~⊃(∩
YRh⊂I_h⊃3Iz1r
Ic"B)YuQ2$λ ∀2
YRb"'4∩∪sλD⊂3∪∧λr5Q)d⊂4QjY13U
5β"B(823⊃$
∃ Ky∪Rs xc"B$
qrP$
∃sH→∪tq!QB4∃*9∩H⊃K
⊂3 Rsα'P g"λ$g)j⊂f"⊂*∩"fFEαh'h%λ(⊗εEβεE≥]NDdc'λ$'%f∪cFEεB≥]]P∩*g%P⊂f&'aPj$ggλ)'jj∩g"aFBεEεEβE≥]]H&`ebH P$*S%P⊗P
**∀P∩ iP'∃fa"iλ'c⊂$U"fiP∃`g*"Q↔εE≥N]P⊂*∩"g⊂$S)j f∪⊂*$"TbP$j⊃diP#∀'fP(⊃&⊂!,H('h(∩g#P'Q#εE S$'%f∞∧h*iR⊂#,( **εEαh*id∩⊂(⊗ S$*g%BD]ai⊃`j"P⊂P#)"Td⊂$*S%R⊂ S"⊂$g∀j f&λ i#iH#)'fH("&εB∧fgk⊃dP!⊗
TDDNi`k"TP!P⊗H f)gH*ibbλ!,P#⊂if'`QεE∧h∪h⊂(⊗⊂DDDW∀bbP&⊃&$'%HεE∧e∀h⊂*⊗∀"&'&RDD]aPg∪j⊂∀*j⊂(⊃&⊂(jPg*$j⊗P$g*∪P P$∃g%FEαd))'SP V∀⊂∀DD]S ij⊂⊃f"fbS*⊂#gQiP$gλ('idU$gg⊂ εE∧iSig⊂*∃⊗∀#,∀∀FE∧H%))jλ f$'∪,FE∧S)d!P∃*⊗⊗XBD]dgλ"⊗⊂)Rcg⊂!∩j⊂'gλ≡↑←⊂⊃k"g⊂∪*fa"T⊂'c⊂⊃f"fbS*)FEαfgk"RP*⊗∀⊂∀FE∧Pb"$P∃⊗∀**
FE∧bV!d⊂" *∧D]S'kP$S⊂"⊂⊗H& ijλ+gi"λ$g*'H+d$aR⊂*'P∀'hεEαe*fh⊃bP*⊗⊂f$'&⊃εE f∩'& ]αh'h⊂∀⊗ DDB]f'gT⊂*'P∩g)j S&⊂ i⊃iP$gλ$*g%CE∧e)T⊂*⊗(⊃&'&eCE∧d)∪&P V
"∀FE⊂f$'&⊃≥∧igR&⊂** f$'∪,εE∧T'h⊂( FE∧R)h⊂* ("&'∪eFE∧R))&P⊂V∀"∀CE∧igR P"⊗⊂f$'&⊂FEεE⊂f$'&⊗]⊂)eRh'⊂+∪`ed*S%FE∧H$)&-∀P∀!∀CE f$∪&,≥∧T'h$P⊃,(⊗_CE∧bl⊂d⊂ V⊂εE∧h∪h%⊂#⊗(⊗εEβEεE≥N]P f∪'a`j⊃P P$∃g%P'Q⊂)dm⊃P$g"∩a`j"Q⊂$g⊂
**∀FB≥]]Pλ g"⊂∩g$j$Pf$m"H*'P*∩"P⊃*S*ibbλ⊂('dS*"i⊂
⊃[[[M[[TFB f$*S%]∧e∃fh&"H**⊗ S$'%bB]h)"Tbi+"TP i_K i→ H⊗P)bQP)ja∀jεE∧P`df"H**⊗→↔d'%f∪cD]fUij⊂(∀"ibi∃"P*εB∧P%)∀j⊂ f∩'%bFB∧ija∩P**⊗ FE∧e⊃#'P*∃⊗ f$∪%b∧DNibf"Pj⊂!gS)bi⊂⊃'i⊂!Si)"aU⊂)dm⊃P$*g∩FE∧P∩))j⊂⊂f$'%QεE f∩'%b≥αe))jλ f$'∩c⊗YZK∀"∀DNb$ih⊂j!d⊂∃'P$g⊃$k$b∃`f⊂$∃g%P!Sg)bi∀P!"f∪kFE⊂λ) b$V⊂_X↔βE∧i"T"`j⊂∩'%f'QST COLC ALHNK,\<HFKLLπ∞Z]I!π≥λx~∀@AIβ ∪0p~¬β1⊃≥↔ h∪'↔∪A
A-≠¬↔⊃+≥,∩∩v@
α6I↓⊂∧¬$D→hu~αT
D-≥Dλdm∩
Z4*∧βqHλ→βg!FB∧P%)∀j⊂ f∩'%XεB∧e) H V aSg)FEβE_ +≠ HUNK<index: IS THE AKNCER FOR HUNKS GF SIRE 2↑<index> WKRDS.
;;8εAS]⊃KpA]<Xt@@@@@b@d@@f@@h@@j@@h@@@j@@@p@@@r@~∀lrvA]<XAo←β∪∪Miα↓E↓↓⊂∧αβ"∧παααε∩bαβ6 λ∧εMλλ∧ε,N∧εM-H∧ε,,C!'nn`
mkH∩.L;<nD∧ HλεDλ∞∧ε-Hλε6Hλ
FDλ $G∧λ E&dλ
,&$λ $ε&β"C!πnnh
@`i'$S π! THECE CONSERS MUST PRASERT@
A ∧hRh8T*∧β2∃)Imc"AQTQ4λX5λ∩ Ipε'cJXV-FB⊂⊂⊂)T ¬C@!I_
α→jE@(4β"J(1∩6∧ε, C!(pπg!H#`'%K.⊂∞BPAJT,:
∩A!%%5&↓
⊂V9%!π≥P∩w
→U'⊂Aπ%∂⊂→α∀JQ↓5∧r⊗⊗⊃∧ α"VtYα:>8h %α≤Z&B→∧ 2
~@Y:JB≤rP%nLr&R_~D*∧x4∧%,T
Dj∧
Yd]_Q!∩α∧*:α∧
H_t≠ Q(4|T4λ∀dDi5Ebu*λ4u"G!⊂K]h~$L]X4∧E,i4∧ |j8U∃≠$∧∧E,i6αb∧
Yd[
D¬brpQ!∃≤\~λr∧
HhdBZh*∧≤UAQ J∧**5"∧9yd
∧y dZeEj%∧≤hAPPL
*%R¬JEBD
⊃Q%∀ I≠αβ@Q$αα¬λ:E¬∀qQ LlzhTj¬JAD44¬5e∃∧9j@hP~8U$|T¬∧
J↓⊃∪L@54u∧λR3∪∧ 3H⊂iyαh'g⊃g*)P∃dj$⊂∃$"P⊃∃g*ibQ⊃⊂('RdεTER
IFLE &@%Aβ≥(ZHXA% A β(@pc>]%Aπ≥(|4bPA'∃)∨~@9%!π≥PVbQα$~∃∪
≤@]%!
≥(Zdαbd4(Lj>@4Y∀∧"c∃λ∩Hh!→¬∀d∀λBbD∃⊃PPL)JB∧"GF∃zu*λ4e#eR∩D
⊃Q%hh$∧∧t⎇λ)phP~ u∧Rλ¬@hUQ⊃∪L,hD∧`8H⊂Q*λ05λ Rs∪hq"C"KQ".q)Hλ∪qD 1SH Rs∪hq"@↓A"Tu(*∃∪α(~∪s#∧
∪∩4jEλ∀q*J⊃∩4jEλ⊂4j9ph⊂)hλ⊃TI_3Q∀aQC"C!(5∪s'!3∀r∧λ+ 4hXs∪qa⊃.pp)d⊃∪h Jrλ∩λZQ(⊂HXp54hT⊃∪sDzλ∪Q(Xλ⊂4Hq"B4i94⊃q$
u
⊂%⊃".qH→∀q( yS⊗(λitH∪IyK05 Y20c!!(⊃⊃ ((⊂+λ⊃".hλjQ1+*:∪tP(x(∀∪i→U⊃4J1"B(∧ 3uQ$λ+∃U¬i5⊗"!↔sStIX3∪⊗%D∃ λλ*5λ⊃IzH∪R)Dλuβ!!4∪t $∀ β!!"C"IH5∪s'!"""':rr4∧ 1H⊃*∀∃⊃4jD∩4h
:1QR(913U∧λStHλZ503 ~⊗#"J:⊂5∪iWB2U)Z⊃(⊂%F*∃
!⊃.tri~λ∩1D R3λ¬
r∩0i∧∩4h
;30SiE#"Tjλ5 .A~rsu
D⊂+∀k⊃".sλX5Q4d
⊗4⊃$λR5∀d 3H∃
A B( *Tuλ¬
#"A→TTu∧ε*∃
!QA"C!
∀T∪
8.B2JY4⊃(λ∃∀⊂T i3β"A→TTu∧λP3∀hQ"T∪ ~u∞B*9su∃∧λ+∀v%9∀b"'~u0TDε( (λh5⊂r∧
∀StλZU⊗( I4uβ!!(∩TJ:λ∀∀J ∀q#!!2∀TK$⊂+
λ∃#"B* t∩H
¬β"C!*∀T∪I→∞B2
*VH⊂%IR3∀
)t∀b!↔tt⊃(903λ λ0rhλitH∪I→β"B* t∩H
¬β"C!!"TT I6NB)*34⊃$λ+∀T
9R3β!!)1uλ∀⊃P4hZC"ThZ∀∪∩*:∞C"A~rsu
D⊂+∀k∃s∀b':u0TDεH
85λ∀
)t⊃4JK(∪∩*:β"B$ TTu∧
T∪∩+!"B2
*S(⊂EE⊂*#!!33uHT⊂+⊂AQB4∪j H∀ ↓Q@εE)∀)g$f∞∧d))∪P!⊗'∩f(!'T)DD]Th"adPf⊂$ PeP#'T⊂'$fβE∧h'T%⊂(⊗βEαEεB)j"g∃≥∧fgU"dP*∃⊗∀ TBD]cbU⊂)j⊃e*),H#'i⊂⊂P$g⊂∃*εE∧S)d⊂*∃⊗⊗ibQf'cDB]c'iλ*ibP∃d"i"H)h aQP&gi⊃P$fh∪i* g∃⊂*$ S⊂*$fQFE∧fSk"P*∃⊗)j∀∃*∀FEαe))jλ∀*∀FBεE+ S&!b]αkj P⊗g'g⊗Tlfa'S⊂⊗P+⊂f*bVPbf&⊗S'a`j∩gg⊂nCE∧e)∀j⊂+ S&!XFB+ f&∪a]∧h∃id⊂( !c$l FE+ S&!X]αe*fh⊃P V+∪!g$fβE∧e)T⊂*⊗)T j'fCEP%∀)j⊂+⊂f&!bCEd&∀-⊂"* ∀ TFB∧d))⊗⊂**⊗
**∀FB∧a`dS⊂**⊗∀jg!'Ug"εEαP)bj⊗⊂**⊗βE∧h'T%⊂(⊗βEαE+∪!g$f∞∧fgk⊃dP"* +'$fβE∧h'T%⊂ ⊗βEαEβ∧AεE∀`iihN∧iedT P",ASSA ;[IASSQ]
λ¬'β'M≠εt∪5∨% ∩↓(Y∪βM'∨ε~(∪!+'!∀A X!(R4PJ≤ IHbβαEλ2Hh!~∧⎇∧$
α`h!Q$
≥9x3PM99∃∧
@
84tsh1".vi_4tsh;#"P*:t.B)YuQ2$
∩0*:t#"A~∃4r $∀
E"".ejq1(
:qptε∀ (∪*Zuλ∀
(4q4JhαP!εB# f)Q]fgU"dP K'$fεB∧h'h∩⊂(⊗εBεEεE∩`iigP]∧fgU"dP# *)*j∩∧D]dS*"i'⊂f⊂⊃ TicaQβE∧ibU-&P&Qfk⊂∧BW)bbH""f TihFEαe)h⊂∃⊗& j∪fFE∧H%))jλ$`iiPXεE$PiihMαibj-⊂⊂#⊗&Qfk∧DK)bbP⊃"f iThFE∧Tedh'λ+↔))QjεE∧H%))jλ$`iiTc∧D]Q ij∃ i)dSe⊂'cλ iihH+dj$λ''P!R ¬CKILG
IASSC0: SOVE B F A B ;ASSMC LOMP WITH CHEC@↔∪9∞~∀∪5∨%
AQ(Y∧~(∪∃%'PA∪β'Mεn~∃%β''εLt∪⊃→I4A(YP~∀&-B∞!α"a"A∧HIe"AJα">2%→αNV≤~⊗NNM2∃αR J2Mα|1α2&≥ 4(→Yu$ T
BdlYZ`hP→Yu$(⊃∃¬Jβ"R(~tpmg!4rsjJλ⊃∃¬I∀c"A∀∩TTjD∩04j8mβ"A→3uTd
⊂
¬ εE∧Tegj*λ*⊗&)CEP%∀)j⊂$PiiaYBD]P⊂λ⊂⊃'$S⊃⊂"g∃)$biH#bj⊂⊂,h iTbb⊂$⊃i"FEαd&)-λ!⊗∀*
FE∧aPfg⊂! ⊗XT(
DD]VLT(∀P∩'f")H$j"fH!"dg⊃P)gjQd*εEαP%))U⊂$`iTalεEαiedh∪⊂⊗Y∀∀∀DD]KY∀(∀H#& cH≡P∀∀H#'i⊂⊂iihFλ''g⊗J∀P#'T⊂ iiSaFE∧H%))jλ$`iiPYFE∧Sgk"P⊂V⊗XT∀∀FE∧T*id%λ(⊗"hU`fεEαfgk)H*⊗ ∀∀∀BE∧R*fh"H V$`TiaYFB$`iiPl≥∧h∪h⊂(⊗⊂εE∧h∪h$P( →FE∧R))j⊂∩`ikdS∧EεE∩`iiaM≥∧ieRh'⊂∀∀∀BE∧H%))jλ$`if∪iFE∧R)h⊂* &bfhQiεE∧H%))jλ$`iiPYFE$Pif'iN∧h'h∩P(⊗~βE∧h'T%⊂(⊗βEεEεB$`iiTX≥∧fSk"fP⊂⊗&bfUεE∧d∪)-⊂! *εE$Piihc∞∧e*fT"P!⊗⊂h'h%αD]c Tj⊂+"T)`ggλ'c⊂ TihP+Rj$⊂'∪P!d"Pedg#CEfgU)P*⊗
!∀DDNP⊂⊂&Uij⊂(∀"ibi∃"P i P⊗P∀bbP#⊂if hβE∧d&∀-⊂** ∀*∀DB]P⊂⊂∪'j"P P&jiU⊂''jλ*ibP∪j$"iλ*$ gλ V⊂! ⊂*⊗⊂∃*εE∧P`dbP⊂V∀**
DD]Pλ⊂!"aPjibP∪c⊂ iThSiP⊃'i⊂)⊃`b⊂!R i⊂&Pai'iCE∧P%∀)j⊂$PiihXβE∧j)∪'⊂*⊗ XDD]Th*i$SjiP&Pj!d⊂∪c⊂⊃∀
Q⊂+dU$⊂'*S&⊂)f∪jεE∧H%))jλ$`iiTX∧D]H"W#Wλ⊂∀∀ H↔⊂_TH∀∀P∀
∀P↔⊂
TTFE∩`ikdS≥∧h'T⊂(⊗*αFE∧d∪))⊂ K∀!∀DB]a*jλ"l$jλ!,P)Rdh($S#P$cλ+dg⊗λ&"`k∩g#P#∩g fεB∧e))U⊂_T*
DD]Pλ* dfλ$g⊂∀⊂∀P⊂⊗H⊂↔)bQP)icPh_FEαFEεEβεEεEβE≥T"⊃c*g⊂⊃$ih&⊂abP∀⊗⊂,TFB≥P⊂⊂λ⊂⊂⊂∀⊂g"⊂∀⊂j'fP⊗∀P∀"T)'i⊂ }''jλ P&$Tj⊂⊗P⊃$ih&⊂ab}⊂⊗∀TFE∞P⊂⊂⊂λ⊂⊂∀!Sg"⊂∀
j'fH,TFE∞DP⊂⊂λ⊂⊂⊂∀∀(& aPP,⊂∪T)'cg
FE≥DH⊂⊂⊂⊂λ⊂∀)(∪ ab⊂⊗⊂∀'!Sg)P,JTTFE∞DP⊂⊂λ⊂∀∪jλ∀)(&⊂a`P,λ∀!`iλ,TTFB≥DDP
)(& Pb⊂,⊂
!b)⊂⊗TTTTJFE"$Th&_≥αkj P⊗g'j⊂⊂P&$iU⊂⊗P"∩ih& PbPnFB"$ih∪ ab]βE∧fgU"dP*∃⊗∀ TBD]dg∀ji"P⊃$i)jλ i#P∩iP P∪$ijεB∧f)dλ**⊗⊗Tbcf'QFE∧iRdh&⊂∀j∀**
DD]dTP$j∨CE∧P%∀)j⊂"∩ih&_βE∧fgU"dP*∃⊗∀!∀BD]ad⊃aeP+R"j$"T⊂)baSg"⊂ T#P$iH&$ijλ'i⊂'∪jεE∧S)d⊂*∃⊗⊗ibQf'cFB∧iedT&⊂)j
**∀DB]f$iU∨FE∧H%))jλ"$ih∪_DD]S'h"Vλ)h"aR`f⊂*∀"`j&Qg*εE⊃$ih& ≥∧d&∀-⊂ i V∀!∀BD]a`T⊂,FEαd)&&H i_V
TDDNi(& P`P,εB∧d))⊗⊂ i_K∀!∀DB]ab)λ,FE∧R))&P⊂i_V∀⊂TDD]T(& aQ⊂,εEαh'h%λ(⊗∧DB]i"j∃i'⊂,βE"$iT&_]∧Sgk"dH!V(h∀'cgεB∧d)&∪P!V∀⊂TDD]J)(& P`P≡_Tj⊗`i⊃←⊂∪h∀'cg∀CE∧h*Td⊂(⊗⊂DD]g∪kP∀'⊂gg)P∂→'"⊂⊂i#←∀CE∧fgU"dP K∀!∀FB∧h*iR%⊂(⊗ '!gg∀FE∧d∀)&P K ∀(∀BD]T)∀& abλ≡_ij `i#←λ∀'!gS)P≡→∪"⊗`i⊃←∀TFB∧h'hλ(⊗ DBD]i"U*i'⊂⊃$i)jλ i#FB∧h'h∩⊂(⊗εBεE≥]H$g⊂#∪f&'kRe#P*∃P#*g∀V⊂!`S⊂(*jλ P⊃(⊂cbP'∃fa"iλ⊂$g*∪P aaH P+dU$⊂∪dSh*g$U,SFEβE(*i⊃h≥∧f∀d⊂ V ibcf∪cDDPλ⊂≥s4[2⊂:4→P2w:≤<P4wλ:42P≤rsvr[:⊂:0X62FEαfgk"H**⊗)U∀ TDBP⊂⊂≥J;rP;Xw:⊂*~2P6"Y:⊂40[3⊂:7[TFE∧U&'"P∃*⊗)j (*iεB∧P⊂%∀)j⊂*∀*bFEαe))jλ# f)QFEεE∃i$j"Pa&"h∞εE∧f∀d⊂ V ↑)bcS'cUiQiRh#KX←εE∩c'⊂$U)V-FB∧W!`S&⊂-iQj-⊂∨H)dl!∩j⊂↔aSi*,h P∨P H∨P∩aS'jj⊗ P∀∀∀bj-∀JP.FEαP⊂!`R`FE∧R*fh&λ V*)∃bFE.B]bg"λ'c⊂$Q'⊂$j∀FE$c∪⊂"→_ -FE∧R)&$P⊂V↔#$∀f#εEαi( aTFE∧j∪'"P! ∀( RUj∀FEαP%))U⊂*)*QFE.DNbg"⊂∪c⊂$c∪⊂"→_βE$c'λ"_X⊗⊗FE$c∪⊂)`dS⊗-FEαibj-λ**⊗εB∧a`f∪$P"* ~___ _DD]Tbcg*SP'g∀`df⊂
*"ijλ#'i⊂∩$ibcJFE∧e∃fh"P∃*⊗*)∃bFE.B]bg"λ'c⊂$Q'⊂)`RfεE∧P`dcbH V$$S'aFEαP%))U⊂*)*QFE.DNbg"⊂∪c⊂$c∪⊂"_XβEe)∀j⊂# S)bFEβEεE
SUBTTL GET, FBOUNDP, GETL, PUTPROP, REMPROP FUNCTIONS
$GET: JSP TT,GETCHK
JRST FALSE
JFCL ;LET ORDINARY HUNKS GO THRU
GET1: HRRZ TT,(A) ;MUST PRESERVE B, C, AR1, T, D
;(SEE EVAL AT EV3, MKNAM3, SETF1B, .REARRAY, AND ARRY1)
HLRZ A,(TT) ;ALSO PRESERVE R, SEE UUOH1 AND SEE PRNN2
CAIN A,(B) ;ALSO AR2A AND F, SEE FASLOAD
JUMPN TT,GET2
HRRZ A,(TT) ;USES ONLY A,B,TT
JUMPN A,GET1
POPJ P,
GET2: HRRZ TT,(TT)
HLRZ A,(TT)
POPJ P,
SARGET: MOVEI TT,(A)
LSH TT,-SEGLOG
MOVE TT,ST(TT)
TLNE TT,SA
POPJ P,
ARGET: JSP T,SPATOM ;GET ARRAY PROPERTY FROM ATOM
JSP T,PNGE1
ARGET1: MOVEI B,QARRAY
JRST GET1
PNGET: JSP T,SPATOM ;INTERNAL SUBROUTINE -GET PNAME PROP FROM ATOM
PNGT1: JSP T,PNGE
PNGT0: SKIPN A ;SAVES B
SKIPA TT,[$$$NIL]
HLRZ TT,(A) ;MUST DO IT INTO TT SO AS TO HAVE
HRRZ A,1(TT) ; CONTINUOUS GC PROTECTION
POPJ P,
.SEE CRSR40
GETCHK: ROT A,-SEGLOG ;CHECK FIRST ARG FOR GET, GETL, AND PUTPROP
HLL TT,ST(A) ;SKIP 2 IF OK, 1 IF NON-USER HUNK,
ROT A,SEGLOG ; ELSE NO SKIP
TLNE TT,SY ;SYMBOL IS SUPER-WIN
JRST 2(TT)
TLNN TT,LS
JRST GTCK1
TLNN TT,HNK
JRST 2(TT) ;REGULAR LIST IS FINE TOO
PUSH FXP,T
PUSHJ P,USRHNP
JUMPE T,[ POP FXP,T
JRST 1(TT) ] ;SKIP 1 FOR NON-USER HUNK
POP FXP,T
GTCK1:↓JUMPN A,(TT) ;NO SKIP -- RANDOM FROB
↓MOVEI A,NILPROPS ;SIGH, SPECIAL CASE FOR ()
JRST 2(TT)
FBOUNDP: MOVEI B,FBDPL
GETL: SKOTT B,LS
JUMPN B,GETLE
GETLA: JSP TT,GETCHK
JRST FALSE
JFCL
GETL1: JUMPE B,FALSE ;FLUSH DEGENERATE CASE OF NO PROPS
JRST GETL1A
GETL0: HRRZ A,(A) ;USES A,B,C,T,TT
JUMPE A,CPOPJ
GETL1A: HRRZ A,(A) ;GET NEXT OFF PROPERTY LIST
JUMPE A,CPOPJ
HLRZ T,(A)
MOVE C,B
GETL4: HLRZ TT,(C) ;MEMQ IT DOWN LIST OF PROPS
CAIN T,(TT)
POPJ P,
HRRZ C,(C)
JUMPN C,GETL4
JRST GETL0
;;9 ARGUMENTS ARE A SYMBOL, A VALUE, AND AN INDICATOR.
;;; THE INDICATOR MUST NOT BE A PDL QUANTITY (RECALL THAT THE
;;; EQNESS OF SUCH QUANTITIES IS UNDEFINED IN THE LANGUAGE ANYWAY).
;;; THE VALUE IS PDLNMK'D IF NECESSARY. THE SYMBOL MAY BE A LIST
;;; (KNOWN AS A "DISEMBODIED PROPERTY LIST"; THE CDR IS THE PLIST).
;;; IF THE PROPERTY ALREADY EXISTS, THE NEW VALUE IS INSTALLED THERE.
;;; OTHERWISE A NEW PROPERTY IS INSTALLED AT THE FRONT OF THE
;;; PROPERTY LIST. IF THE PROPERTY ALREADY EXISTS IN A PORTION
;;; OF THE PROPERTY LIST THAT IS PURE, ENOUGH OF THE PURE PART
;;; IS COPIED AS IMPURE LIST STRUCTURE TO PERMIT THE PUTPROP.
;;; IF THE VALUE OF *PURE IS NON-NIL, THEN THE VALUE IS PURCOPY'D
;;; AND THE NEW PROPERTY LIST CELLS, IF ANY, ARE PURE-CONSED.
PUTPROP:
JSP TT,GETCHK ;NORMALIZE FIRST ARG
JRST PROPER ;DONT TRY "PUT"TING ON RANDOM FROBS
JFCL ; LET NON-USER HUNKS GO THRU
CAML B,NPDLL ;MAKE A QUICK TEST ON THE SECOND ARGUMENT
CAML B,NPDLH ;SHIP-OF-THE-DESERT TEST (TWO CAML'S)
JRST CSET0Q
EXCH B,A ;LOSE - MUST PDLNMK THE VALUE
JSP T,PDLNMK
EXCH B,A
CSET0Q: MOVEI T,(A)
CSET0: HRRZ T,(T) ;MUST SAVE AR1,R,F FOR FASLOAD - SEE LDENT
JUMPE T,CSET2 ;SEARCH FOR AN EXISTING PROPERTY
HLRZ TT,(T)
HRRZ T,(T)
CAIE TT,(C)
JRST CSET0
JSP D,CSET8 ;SKIPS, UNLESS HAD TO PURCOPY THE PROPERTY
JRST CSET5
SKOTTN T,PUR
JRST CSET4
CSET0A: ;IF PROPERTY EXISTS ALREADY (IN IMPURE CELL)
PURTRAP CSET4,T,HRLM B,(T)
BRETJ:
SPROG2: MOVEI A,(B) ;RETURN VALUE
POPJ P,
;; DOESN'T HAVE SUCH A PROPERTY, SO CONS ONE UP
CSET2: PUSH P,A
JSP D,CSET8 ;SKIPS, UNLESS HAD TO PURCOPY THE THING
JRST CSETP1 ; SO, IF IT MUST BE A 'PURE' PROPERTY ...
CSET2A: HRRZ A,(A) ;PLAIN VANILLA CONSES
PUSHJ P,XCONS
HRRZ B,C
JSP T,%PDLXC ;IN CASE SOMEONE TRIES TO USE A PDLNUM
POP P,C ;ORIGINAL ATOM WAS SAVED ON P
HRRM A,(C) ;SETPLIST TO NEW THING
$CADR: HRRZ A,(A) ;RETURN VALUE (I.E. GET IT BACK)
$CAR: HLRZ A,(A)
C$CAR: POPJ P,$CAR
;; A HAS BEEN PUSHED ONTO P WHEN WE GET HERE
CSETP1: MOVE A,B
SKIPA T,(P) ;GET PLIST OF OBJECT
CSETP2: HRRZ T,(B) ;LOOP UNTIL PURE PART FOUND (OR END OF PLIST)
HRRZ B,(T)
JUMPE B,CSETP3
SKOTT B,PUR
JRST CSETP2
CSETP3: PUSHJ P,PCONS ;pure-cons the words of the PLIST
MOVEI B,(A)
MOVEI A,(C)
PUSHJ P,PCONS
HRRM A,(T)
POPI P,1
JRST $CADR
CSET8: SKIPN V.PURE ;PURCOPY THE PROPERTY IF IT IS OF
JRST 1(D) ; THE KIND FOUND ON 'PUTPROP'
SKIPA TT,VPUTPROP ;SKIP IF NO PURCOPYING ACTUALLY HAPPENS
CSET8A: HLRZS TT
JUMPE TT,1(D) ;FAST, OPEN-CODED MEMQ LOOP
MOVS TT,(TT)
CAIE C,(TT)
JRST CSET8A
PUSH FXP,D ;RET ADDR!
PUSH FXP,T
PUSHJ FXP,SAV2 ;SAVES B,A ON TOP OF 'P'
MOVE A,B
PUSHJ P,PURCOPY ;PURCOPY THE PROP VALUE
MOVEM A,-1(P)
SKOTT C,SY ;IS THE FLAG A SYMBOL?
JRST CSET8B
HLRZ T,(C) ;POINTER TO THE SY2 BLOCK
MOVE T,SYMVC(T) ;GET THE FLAG BITS
TLNE T,SY.PUR ;IS IT ALREADY PURE?
JRST CSET8B
MOVE A,C
PUSHJ P,PURCOPY ;NO, PURCOPY IT
MOVE C,A
CSET8B: POP FXP,T
JRST RST2
CSET5: SKOTTN T,PUR ;SO, PROPERTY IS TO BE PURIFIED!
JRST CSET0A ;BUT EXISTING PROP IS PURE, SO TRY TO CLOBBER
SOVE A B ;BUT IF EXISTING PROP WAS IMPURE, THEN REMPROP
MOVE B,C
PUSHJ P,REMPROP ; IT AND TRY THE "FRESH PROPERTY" ROUTE
POP P,B
JRST CSETP1
;; COME HERE BY PURTRAP WHEN TRYING TO CLOBBER INTO AN UNWRITEABLE PAGE.
CSET4: PUSHJ FXP,SAV2
MOVEI T,(A) ;FOOL PROPERTY IS IN A PURE PAGE
CSET4A: HRRZ TT,(T) ;COPY ENOUGH OF THE PROPERTY LIST
PUSHJ P,CSET4C ; TO PERMIT THE PUTPROP
HLRZ A,(TT)
CAIE A,(C)
JRST CSET4A
PUSHJ FXP,RST2
JRST CSET0A
REMPROP: ;SUBR 2 - REMOVE PROPERTY FROM ATOMIC SYMBOL
SKOTT A,LS+SY
JRST REMP7 ;MUST SAVE AR1,R,F FOR FASLOAD - SEE LDENT
REMP0: SKIPA D,A ;SAVE C, AR2A - SEE DEFPROP AND DEFUN
REMP1: HRRZ D,(T)
HRRZ T,(D)
JUMPE T,FALSE
MOVS TT,(T)
CAIE B,(TT)
JRST REMP1
HLRZ T,TT
REMP20: HRRZ TT,(T) ;A IS GC-PROTECTING THE ATOM
PURTRAP REMP3,D, HRRM TT,(D)
MOVEI A,(T)
POPJ P,
REMP7: JUMPN A,RMPER0
MOVEI A,NILPROPS
JRST REMP0
CSET4C: PUSHJ P,.+1 ;HAIRY WAY TO DO A DOUBLE COPY!
HRRZ A,(T)
MOVE B,(A)
PUSHJ P,CONS1
HRRM A,(T)
MOVEI T,(A)
POPJ P,
REMP3: PUSH P,A ;COME HERE ON PURE PAGE TRAP
PUSH P,B ;A ON PDL GC PROTECTS ATOM
MOVEI T,(A)
REMP3A: PUSHJ P,CSET4C ;COPY ENOUGH OF PROPERTY LIST
HRRZ TT,(T) ; TO DO REMPROP
HLRZ A,(TT)
CAME A,(P)
JRST REMP3A
HRRZ A,(TT)
HRRZ TT,(A)
HRRM TT,(T)
JRST POP2J
SUBTTL NOT, NULL, BOUNDP, PAIRP
NOTNOT: JUMPE A,CPOPJ ;REPLACES A NON-NIL VALUE BY T
JRST TRUE
αNOT:
$NULL: JUMPN A,FALSE
TRUE: MOVE A,VT.ITY
CNOT: POPJ P,NOT
BOUNDP: JUMPE A,TRUE ;SUBR 1
JSP T,SPATOM ;TRUE IFF THE SYMBOL ARGUMENT IS BOUND
JSP T,PNGE1 ;ERROR FOR NON-SYMBOLS
HLRZ T,(A) ;GET VALUE CELL
HRRZ A,(T) ;DO IT INTO T TO PROTECT FROM GC
HRRZ T,(A)
CAIN T,QUNBOUND
TDZA A,A
MOVE A,VT.ITY
POPJ P,
PAIRP: PUSHJ P,TYPEP
CAIE A,QLIST
TDZA A,A
MOVE A,VT.ITY
POPJ P,
;;;; LAST, RUNTIME
LAST: PUSHJ P,LLASTCK ;SUBR 1 - GET LAST CONS OF A LIST
JRST LAST4
LAST5: MOVE A,D
POPJ P,
LAST4: CAIE F,-1
JRST LAST5 ; (A B C ... . Z) CASE
SKOTTN A,LS ;SO WE TOOK NO CDRS!
JRST LAST5 ; (A . Z) CASE
HRRZ TT,C2 ;FOO! ALLOW RANDOM PTS TO PDL, FOR SAKE
CAILE A,(TT) ; OF THAT KLUDGEY CODE OUTPUT BY THE
CAILE A,(P) ; COMPLR FOR MAPCAN ETC.
JRST LASTER
SKIPN TT,(A)
POPJ P,
MOVEI A,(TT)
JRST LAST
LLASTCK: MOVEI F,-1 ;"LONG" LAST CHECK
; REPURNS <262143.-<NO. OF CDRS TAKEN>> IN F
; MUST PRESERVE T,R. SEE APPEND, REVERSE, NTHCDR
LASTCK: SKIPN D,A ;SKIP RETURN ON NORMAL-FORM LIST
JRST POPJ1 ; LEAVES PTR TO LAST NODE IN D,
SKOTT D,LS ;() IS OK, AND IS ITS OWN "LASTNODE"
POPJ P, ; BUT OTHER ATOMS LOSE
JUMPLE F,POPJ1 ; LIMITED TO (F) CDRS
LAST1: HRRZ TT,(D)
SKOTT TT,LS
JRST LAST2
HRRZ D,(D)
SOJG F,LAST1
JRST POPJ1
LAST2: HRRZ TT,(D)
JUMPE TT,POPJ1
POPJ P, ;ENDED WITH NON-NULL ATOM
3;; REDURN RUNTIME AS A FIXNUM IN MICRMSECOND
;;; UNITS (NOT NECESSARILY THAT ACCURATE THOUGH).
$RUNTIME8
PUSH P,CFIX1 ;CUBR 0 NCALLABLE
IT$ ,SUSET [.RRUNT,,TT] ;RUNTIIE IN 4-MICROSECOND UNITS
10$ SETZ TT,
10$ RUNTIM TT, ;RUNTIME INMILLISECONDS
IFN D20,[
LOCKI ;MUST LOCKI OVER ALL JSYS'S
MOVEI 1,.FHSLF ;GET RUNTIME FOR SELF
RUNTM
MOVE TT,1 ;RUNTIME IN MILLISECONDS
SETZB 1,3 ;1 AND 3 HAVE DANGEROUS CRUD
UNLOCKI
] ;END OF IFN D20
RNTM1: ;CONVERT NUMBER FROM INTERNAL UNITS TO USECS
IT$ LSH TT,2
IT% IMULI TT,1000&
POPJ P, ;ANSWER IN MICROSECONDS
SUBTTL TIME FUNCTION
;;; RETURN A TIME STANDARD AS A FLONUM IN SECONDS.
;;; WE ENDEAVOR TO MAKE THIS INCREASE MONOTONICALLY AND TO MEASURE
;;; THE PASSAGE OF REAL TIME. IN PRACTICE, WE MAY NOT MEASURE
;;; REAL TIME WHILE THE TIME-SHARING SYSTEM IS TEMPORARILY STOPPED,
;;; AND WE PERMIT A GLITCH (RESET TO 0) AT MIDNIGHT OF EACH DECEMBER 31.
;; DECIDE ON THE "TIMER CONSTANT" INTERVAL -- 1/30 SEC FOR ITS, 1/1000 FOR D20
IFN ITS,[
DEFINE TMCNST
30.0!TERMIN
DEFINE TMXCNST
30.!TERMIN
]
IFN D20,[
DEFINE TMCNST
1000.0!TERMIN
DEFINE TMXCNST
1000.!TERMIN
]
$TIME: PUSH P,CFLOAT1 ;SUBR 0 NCALLABLE
IFN ITS\D20,[
IT$ .RDTIME TT, ;GET AMOUNT OF TIME SYSTEM HAS BEEN UP
IFN D20,[
LOCKI ;MUST LOCKI AROUND THE JSYS
TIME ;GET TIME SINCE SYSTEM LAST RESTARTED IN MSECS
MOVE TT,1
SETZ 1, ;ZERO CRUD
UNLOCKI
]
; CAMGE TT,[30.*3600.*24.*28.] ;FOUR WEEKS OF 1/30 SEC TICS
; JRST .+3
; SUB TT,[30.*3600.*24.*28.]
; JRST .-3
JSP T,IFLOAT
FDVRI TT,(TMCNST)
] ;END OF IFN ITS\D20
IFN D10,[
IFE SAIL,[
MOVE T,[%CNDTM] ;INTERNAL DATE/TIME STANDARD,
GETTAB T, ; AS DATE,,FRACTION OF DAY
JRST TIME3 ; 1-ORIGINED ON NOVEMBER 18, 1858
ADD T,[2*365.+1-43.,,] ;ALTER TO 0-ORIGIN ON JANUARY 1,1856
IDIV T,[365.*4+1,,] ;GET THIS MOD A FOUR-YEAR INTERVAL
JSP T,IFLOAT
FMPR T,[.OP <FSC -22>,86400.0,0] ;CONVERT TO SECONDS
POPJ P,
TIME3: MSTIME TT, ;THIS PRODUCES GLITCHES AT MIDNIGHT
JSP T,IFLOAT
FDVRI TT,(1000.0)
] ;END OF IFE SAIL
IFN SAIL,[
ACCTIM TT,
HLRZ D,TT
IDIVI D,12.*31. ;YEAR-1964 IN D
IDIVI R,31. ;MONTH-1 IN R, DAY-1 IN F
ADD F,TIME8(R) ;ADD IN NUMBER OF DAYS PRECEDING CURRENT MONTH
TLNN D,3 ;SKIP IF NOT LEAP YEAR
CAIL R,2 ;SKIP IF JANUARY OR FEBRUARY
SUBI F,1 ;ADJUST FOR CRETINOUS LEAP YEARS
IMULI F,24.*3600. ;CONVERT TO SECONDS FROM LAST MIDNIGHT TO MIDNIGHT LAST DEC 31
TLZ TT,-1
ADD TT,F ;ADD IN SECONDS SINCE MIDNIGHT LAST
JSP T,IFLOAT
] ;END OF IFN SAIL
] ;END OF IFN D10
POPJ P,
IFN SAIL,[
TIME8:
ZZZ==1 ;WILL SUBTRACT THIS 1 BACK EXCEPT FOR AFTER FEB 29'S
IRP X,,[31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.]
ZZZ
ZZZ==ZZZ+X
TERMIN
IFN ZZZ-366., WARN [TABLE OF CUMULATIVE DAYS IN MONTHS LOSES]
EXPUNGE ZZZ
] ;END OF IFN SAIL
SUBTTL EQUAL FUNCTION
EQUAL: CAIN A,(B) ;EQ THINGS ARE EQUAL
JRST TRUE ; .SEE ASSOC - MUST PRESERVE F
MOVEM P,EQLP
PUSHJ P,EQUAL1 ;EQUAL1 ACTUALLY RETURNS ONLY IF EQUAL
JRST TRUE
EQUAL0: CAIN A,(B) ;EQ THINGS ARE EQUAL
POPJ P,
EQUAL1: MOVEI T,(A)
MOVEI TT,(B)
ROTC T,-SEGLOG ;GET TYPES OF ARGS
HRRZ T,ST(T)
MOVE TT,ST(TT)
CAIN T,(TT) ;MUST HAVE SAME TYPE TO BE EQUAL
2DIF JRST @(T),EQLTBL,QLIST .SEE STDISP
IFE HNKLOG, JRST EQLOSE
IFN HNKLOG,[
SKIPE VHUNKP
JRST EQL1A
TLNN TT,LS ;IF VHUNKP CONTAINS NIL, THEN WANT TO
JRST EQLOSE ; TREAT ALL HUNKS AS IF THEY WERE LIST CELLS
SKOTT A,LS
JRST EQLOSE
JRST EQLLST
EQL1A: SKIPN USRHNK ;IS THE USRHUNK/SENDI FEATURE ENABLED?
JRST EQLOSE
TLNE TT,HNK ;IF VHUNKP CONTAINS T, THEN WANT TO SEND
JRST EQL1B ; THE "EQUAL" MESSAGE IF EITHER ARG IS HUNK
SKOTT A,HNK
JRST EQLOSE
SKIPA
EQL1B: EXCH A,B ;MUST ALWAYS SEND TO FIRST ARG
JRST EQLH4A
] ;END OF IFN HNKLOG
EQLLST: PUSH P,(A)
PUSH P,(B)
HLRZ A,(A)
HLRZ B,(B)
PUSHJ P,EQUAL0 ;COMPARE CARS
HRRZ A,-1(P)
HRRZ B,0(P)
SUB P,R70+2
JRST EQUAL0 ;COMPARE CDRS
EQLTBL: EQLLST ;LIST
EQLNUM ;FIXNUM
EQLNUM ;FLONUM
DB$ EQLNM2 ;DOUBLE
CX$ EQLNM2 ;COMPLEX
DX$ EQLNM4 ;DUPLEX
BG$ EQLBIG ;BIGNUM
EQLOSE ;PNAME ATOMS MUST BE EQ TO BE EQUAL
HN$ REPEAT HNKLOG+1, EQLHNK ;HUNKS REQUIRE REAURSIOH A→%↔
A→%'!&~(∪ #→='
∩∩m%β≥ =≠&Aβ9λA≥∪0A≠+'PA¬
A∃"A)≡↓¬
A E+β_~(∪ #→='
∩∩mβ%%βdA!∨∪9) %&↓≠+'(↓¬αA DA)∞A
A #Uβ_~∃%
≤@\5 #→) _[≥)e! &X↓/β%≤↓7/%∨9∞A→ 9∂)⊂AQβ¬→ t~∀
∃%
≤A a
→β∞16~∃ E→≥~hh~∃↔α%≠∨-
↓(XdQ∧R~∃↔∧∪≠∨-∀A)(XLQαR~)↔∪↔_% ≠∨-∀A(Xd!αR~∀%πβ≠≤↓(XdQλR~∀∩↓πβ≠
↓)(Xf!∧R
∀$@A∃%M(A #1∨'
~):∩∩w∃≥λA∨_A∪
≤↓ 1
→¬∞~∃∪→≤A ¬→→β∞W
1
→β≤Y6~∃∃#→≥~Ht∪≠∨Y
A(XDQαR~(∩Aπβ5
A(XDQ∧R~(∩@A∃I'(A E→∨'
4∃:∩∩m ≥λA= A∪
8A ¬
1β∞Wπa
→β∞4∃ #→9+~t∪5∨-
APXQαR4∀∪πβ5≤A(X!∧R∩∩mπ∨≠!¬%
A-¬→+ &↓∨ A≥U≠¬ %L~∀∩AA∨!∀A@X~∃ E→∨'
h∪≠∨-∀A Y E→ ∩∩m)⊃
AU→)∪≠¬)
A
¬→'∪)d@ZA Mπβ!
↓¬βπ⊗4∀∪∃%M(A
β1'
∩∩lA)≡AQ∨ A→∃- _A= A ≥Q%2A)<A #+¬_A/∪Q⊂A
β1'
~∀4∃∪
≤↓¬∪∂≥U~Y6~) #→¬%∞t∪⊃1%4A(0QαR~(∪⊃→%hA)(X!∧R
∀%πβ∪
↓(XQ)PR∩∩w∃#+β_↓¬∪∂≥U≠&A⊃¬-
A DA'∪∂9&~∀∩↓∃%'(↓ #→∨M
∩∩v↓β≥λA
%&A¬%
A E+β_A1∪')&↓∨ A
%1≥+≠L~∀∪⊃I%4Aα0QαR∩$wπ⊃
⊗A∨≥12A #Uβ_Aπ⊃%&~∀%⊃%%4↓∧XQ∧$~∀∪∃I'(A E+β_`4∃:∩∩m ≥λA= A∪
8A¬∪∂9+~~∀4∃∪
≤↓⊃≥↔→=∞Y6~) #→⊃9⊗t∪'-∪!≤AY⊃+≥↔@~∀∩A)%'(A∃#→→'P~∀∪'-∪!
AU'%⊃≥,~∀∩A)%'(A∃#→⊃≤P~∃ #1⊃≤ft%!+'⊂↓ Yα~(∪!+' A Y∧4∀∪≠∨Y≥∩A(0b~∀@@e ∪_A7→' A(XQQ(S:`1#⊃+≥,`∩w%∃β→→2↓'⊃∨+1λA¬
↓β'⊂X↓¬+(A1'⊂A∪LA
β'Q $A∨8A↔_b@~∀∪⊃I→∩A∧0Q(R~(∪!+' A Yα4∀∪!+M⊂A Yλ~∃ #1⊃≤bt%⊃→%4↓αYZDQ R~(∪⊃%%hA∧XQ@R~∀∪!→%4AλXQ∧R4∀∪!+M⊃∀A 1 #+β0`~∀∪!%%4A∧YZb! R~∀%⊃%%4↓∧XQ $~∀∪⊃I%4A∧0Q∧R~(∪!+'!∀A Y∃#+β_@~∀∪≠=-
A(0Q R~(∪β∨¬) A(Y∃#→⊃≤H~∀∪≠=- ~APXQ R4∀∪β∨L@ZbQ@R~∀∪)%'(A∃#→⊃≤D~∀~∃∃#→⊃≤Ht∪'+λA Y$\`Vh~(∪!∨!(A X~(~∃ #1⊃≤ht%'↔∪!8A+'%!≥⊗∩∩@@w∪LAiQJ↓+'%⊃U≥⊗←'∃≥ ∩A→KCikIJAK]¬EYKH|~∀∩@↓∃%'(↓ #→⊃8f∩∩@@v@A9↑XAG!KGVAQQJAa¬eif~) #→⊂Qαt∪!U'⊂A
a Y #1 ∩∩@@w∂←QiBACMVAiQ∀AkgKHAaeK⊃SGCi∀~∀∪!U'⊂A
a Y)(4∀∪!+M⊃∀A
a Y'βXj~∀∪A+'⊃∀↓ Y+'I⊃≥ ∩$@@@w
QKGV↓M←dAUgKd[!k]W]∃gf~∀%∃+≠!∀A(Y E→⊃≤j$∩@@@m∪LA]=hXAO<AQCG,AShA9←e[C1Yr~∀%!+'⊃(A Y7A+'⊂A@Yα~∀$∩A!+M⊂A Ym# #+¬→:~∀$∩A!+M⊂A Yλ~∀∩∩↓≠∨-≥$A(Xf4∀∩∩Aaπ(A'∃≥ ∩∩$@@@wMK]HAQQJA← UKGh↓BA[KMgCOJ4∀∩∩At~∃ #1⊂i0t%!+'⊃(A
1 1%'(k4b~∀∪A∨ A
a Y)(4∀∪!∨@A
1 1 #→ 4∀∪∃+5!
Aα1 #→∨M
~∀∪)%'(AA∨!¬∀4∀~∃ E→⊃≤jh∪!+'!∀A
1@Y%'(T~∀∪!= A
1@Y)(~(∪!∨ ↓
1 Y∃#→ ~(∪∃%'PA #→!≤f~∀4∀vvAMK]HA∧A[KgMCOJAQ↑ABA!k]VA]SiPA=EUKGPAS\A∧AC]H↓[Kgg¬OJAS8A∧~∃U'%'βλt∪!+M⊃∀A
a Y'βXk~d∩@@w'¬mJAβ Of~∀%!+'⊂↓ Y7%M(k~et~∃+'Iβ∧t∪A+'⊂A@Yα∩∩@@w =\OhAMCmJA¬εOfA%LAGC1YKHA!KeJ~(∪!+' A Y∧4∀∪1πPA' ≥⊃∩~∀∩4∀vvA
QKGV↓αAM←HAEKS9NABA!+≥⊗A¬]HAB↓+'%⊃U≥⊗XAIKike8AC]g]KdAS8A(~∀4∃+'%!! t∪5∨- ∩↓(XQα$~∀∪→M⊂A(X5' ∂→=∞~∀∪5∨-
APY'(QPR∩w∂∃hAgK≥[K]h↓iCEY∀AK]iIr~∀∪Q→≥
APY⊃≥⊗$w∪fA%hABA!k]VA¬hACY0}~∀∩A∃%'PA+'%!≥ ∩vA3Kf0AGCY0AkgKHOfAQ=←V\~))
β→M
t∪'∃)4A(0∩∩w≥=aJ\\8\~∀∪A∨!∀A@X~∀~(vvA∪_AoJA¬eJAkMS]NAQQJA+M%⊃≥⊗0ACggU[S]N↓oJAC1eKCIdAW]←\AShOLABAQU]V\~(~∃+'I⊃≥ t%'↔∪!∀A+'%!≥⊗∩∩@@w≠UghAQ¬mJAE=iPAB↓+'%⊃U≥⊗AC9HABAM ≥ ∩4∀∩@AM↔∪!≤↓' ≥ $∩∩@@v@AS8A←eI∃dAi↑↓[CWJ↓kgJA=LAKSQQKd~(∩@@@↓∃%'(↓)
β→M
~∀∪A+'⊃∀↓
1 YMβ,j~(∪!+'!∀A YMβ-0j4∀∪1πPA+'%!≥⊗∩∩@@wπ!KGVA%hA←kP~∀∪!U'⊃∀A@Y%')`j~∀∪5∨-
APYα∩∩@@w%∃ike\↓mCYk∀AS\APXA]←PAα~∀%!+'⊃(A
1 1%'(j4∀∪!∨A∀A X4∀~∃:$∩w ≥⊂A∨ A%
≤A⊃9↔→∨∞4∀_~∃'U¬))_%≥π∨≥ X@U≥
∨≥εX↓β!! 9λX@U¬!! ≥⊂XA% Y %'
0A≥% Y %'
0A≥%
∨≥ε~(~∃≥π=≥εt∪Q 5αAHY$∩∩m→'+¬H@ZA ∃')%+
)∪- 12AπβQ ≥β)∀A→∪'Q&~∃βA! ≥λh∪≠∨-∃∩A$X9β!! 9λZ]≥
∨≥ε∩m→'+¬H@ZAπ¬) ≥βQ
A¬2↓π∨!3%≥∞~∀%∃+≠!∀A(Y
¬→'
~(∪!∨ ↓ Y∧~)β! dh∪β∨∃∀A(Y¬I )∀~(∪!∨ ↓ Yα~(∪∃+≠A
AαY¬! d~(∪'↔∪A
A,]I' (~(∩A!+M⊃∀A 1β!%-
⊗∩∩~)β! fh∪!+'!∀A X9≥π∨≥ VbQ$$∩w
∪I'(A∪9'(A∨_@]≥π=≥εA∪L@E∃+5!
Aα1¬% )(D~∀∪5∨-
AλYα~∀%∃%'(↓β! d4∀~∀~(]≥π∨9εt∪∃U≠!
A∧Y¬% Q∀∩∩]M
AβA f~∀9≥π≥εDt∪≠∨Y ∩A)PXQαR$∩w'+ $@d@ U≥π∨9εR~∀9≥π≥εHt∪⊃%I4AλX!)(R~(∪∃+≠A
AλX9≥π≥εL~∀∪⊃I%4A)PXQλR4∀∪∃+5!≤A)PX]≥π9εd~∀%⊃%%~↓∧XQλ$~∀∪!=!∀A 0~∀~∀9≥π≥εLt∪⊃%I~A∧X!)(R~(∪!∨!(A X~(~∀~∀9β!! 9λt∪∃U≠!
A∧Y¬% Q∀∩w'U¬$@dPUβ!A ≥λR4∀∪≠∨Y ∩Aε1β$b∩$w
∪%M(A∪≥M(A≠+M(A¬
↓∃+≠!∀AαY¬I )∀~(∪≠∨-∀Aβ$e∧Yα∩∩m≠+'(↓'β-
↓(Yλ@4A'
↓≠β↔∨ →∪'(4∃β! Dt∪⊃→I4AαX!β$eα$~∀∪!U'⊃∀A@Yπ∨≥L~∀∪⊃I%4A∧0QαR~(∪⊃%%4AαXQ R~∀∪5∨-
A Yα~∀%⊃%%4↓β$eα0Qβ$e∧R~∀∪)+≠!≤↓β$eα1β! b4∃β$cI )∀t4∃'+¬Lht∪≠=- ∩A∧XQβ$DR~∀∪A∨!∀A@X~∀~(~∃% Y %'
h∪'↔∪A
A,]I' (∩m'+¬$b@ZAU' &A∧Y∧Yε1(Y ~(∩A!+M⊃∀A 1β!%-
⊗~∀∪5∨- ∩↓εXQα$~∀∪≠=- ∩A∧Y≥∪_$∩w% Y %' LAαA→%'(A¬dAπ∨≥M∪≥∞AU AαA
∨!2~)% ,bh∪∃+≠A
AεY
!∨!∀$∩vA∨_A)⊃
↓)∨ A1 % _↓∪≤A%∃- %'∀A∨% ∃$~∀∪!→%4AλXQεR4∀∪!+M⊃∀A 11π∨≥L~∀∪⊃I%4Aε0QεR~(∪∃%'PA% ,D~∀~∃¬!%-π,t∪!+M⊃∀A 1'β-0L∩∩wβA! ≥λ=% - I'
AβI∂+≠ 9(Aπ⊃∃π↔∪≥≤~∃% Xht∪!U'⊃∀A@Y→→βTCK ;MUST SAVE TT,D,R FOR MANY PLACES WHICH
JRST REVER ; CALL REVERSE/NREVERSE
JRST RSTX3
NREVERSE: MOVEI B,NIL ;SUBR 1 - REVERSE A LIST USING RPLACD'S
NRECONC: JUMPE A,BRETJ ;SUBR 2 - (NRECONC X Y)=(NCONC (NREVEBSE X) Y)
SKIPE V.RSET ; - USES A,B,C,T,F
PUSHJ P,APRVCK
NREV1: HRRZ C,(A) ;ONLY 3 INSTRUCTIONS PER CELL! ZOOM!
HRRM B,(A)
JUMPE C,CPOPJ
HRRZ B,(C)
HRRM A,(C)
JUMPE B,CRETJ
HRRZ A,(B)
HRRM C,(B)
JUMPN A,NREV1
JRST BRETJ
SUBTTL GENSYM FUNCTION
GENSYM: JUMPN T,GENSY1
GENSY0: MOVE TT,[010700,,GNUM] ;STANDARD GENSYMER
MOVEI B,"0 ;WILL INCREMENT NUMERICAL PART
GENSY2: LDB T,TT ; AND GIVE OUT GENSYMED ATOM
AOS T
DPB T,TT
CAIG T,"9
JRST GENSY3
DPB B,TT
ADD TT,[070000,,0]
CAMGE TT,[350000,,]
JRST GENSY2
GENSY3: PUSH FXP,PNBUF
MOVE TT,GNUM
MOVEM TT,PNBUF
MOVEI C,PNBUF
PUSHJ P,PNGNK2
POP FXP,PNBUF
POPJ P,
GENSY1: MOVEI D,QGENSYM
AOJN T,S1WNALOSE
GENSY7: POP P,A
SKOTT A,FX
JRST GENSY5
MOVE TT,(A)
JUMPL TT,GENSY8
MOVE T,[010700,,GNUM]
GENSY6: IDIVI TT,10. ;INSTALL 4 DECIMAL DIGITS
ADDI D,"0 ; IN GENSYM COUNTER
DPB D,T
ADD T,[070000,,0]
CAMGE T,[350000,,]
JRST GENSY6
JRST GENSY3
GENSY5: TLNN TT,SY
JUMPN A,GENSY8
JSP T,CHNV1D
DPB TT,[350700,,GNUM]
JRST GENSY0
SUBTTL MEMBER, MEMQ, SUBST
MEMBER: ;USES A,B,AR1,AR2A,T,TT
SMEMBER:: MOREI AR1,(A) ; FOR BENEFIP OF DELETE
MOVEI AR2A,(B)
↓JSP T,LATGM
JRST MEMBR
SMEMQ: SETZM MEMV ;USES A,B,T,MUST PRESERVE AR1,AR2A;SEE GTSPC3
PUSH P,B
MEMQ2: SKOTT B,LS
JRST MEMQ4
HLRZ T,(B)
CAMN A,T
JRST MEMQ3
HRRM B,MEMV .SEE DELQ ;;used as a "prevIous-cell" ptr
HRRZ B,(B)
JRST MEMQ2
MEMQ3: POPI P,1
JRST SPROG2
MEMQ4: JUMPE B,MEMQ3
JSP T,MEMQER
JRST MEMQ2
¬
MEMBR: SEDZM MEMT
PUSH P,B¬
MEMB2: SKOTT AR∩A,LS
JRST MEMB4
MOVE A,AR1
HLRZ B,(AR2A)¬
PUSHJ P$EQUAL
JUMPN A,MEIB3
HRRM AR2A,MEMV
HRRZ AR2A,(AR2A)
JRST MEMB2
MEMB3: POPI P,1
AR2ARETJ:
MOVEI A,(AR2A)
POPJ P,
MEMB4: JUMPE AR2A,MEMB3
JSP T,MEMQER
MOVE AR2A,B
JRST MEMB2
MEMQ: SKIPE V.RSET
JRST SMEMQ
MEMQ1: JUMPE B,FALSE .SEE THRCAB ;REQUIRES MEMQ1 PRESERVES TT
HLRZ T,(B)
CAIN T,(A)
JRST BRETJ
HRRZ B,(B)
JRST MEMQ1
;;; SUBSTITUTE A FOR EQUAL OCCURRENCES OF B IN C.
SUBST: JSP T,PDLNMK ;SUBR 3
EXCH A,C
JSP T,PDLNMK
EXCH A,C
SKIPA AR1,A
SUBS0A: SKIPA A,AR1
SKIPA AR2A,B
MOVE B,AR2A
PUSH P,C
MOVE A,C
PUSHJ P,EQUAL
POP P,C
JUMPN A,AR1RETJ
SUBS1: SKOTT C,LS ;FOO, THIS INCLUDES HUNKS!
JRST SPROG3
PUSH P,C
IFN HNKLOG,[
TLNE TT,HNK
JRST SUBSTH
]; END of IFN HNKDOG,
HLRZ C,(C) ;A "PAIR" CELL
PUSHJ P,SUBS0A
EXCH A,(P)
HRRZ C,(A)
PUSHJ P,SUBS0A
POP P,B
JRST XCONS
IFN HNKLOG,[
SUBSTH: MOVEI A,(C)
PUSH FXP,TT
PUSHJ P,USRHNP ;Check for being a USER extended hunk
POP FXP,TT
JUMPE T,SUBST8
POP P,A
SOVE AR1 AR2A
PUSHJ P,[PUSH P,A
PUSH P,[QSUBST]
PUSH P,AR1
PUSH P,AR2A
MOVNI T,4
XCT SENDI ;Send the frob a SUBST message
]
SUBSH0: RSTR AR2A AR1
POPJ P,
SUBST8: MOVEI R,1 ;R GETS MAX SIZE IN WORDS
2DIF [LSH R,(TT)]0,QHUNK0
PUSH FXP,R ;CNTR WHILE COPYING
PUSH P,R70 ;TEMP PTR WHILE COPYING
MOVE TT,R
LSH TT,1
PUSHJ P,ALHUNK ;SAVES AR1,AR2A
PUSH P,A
SUBST5: SOSGE R,(FXP)
JRST SUBST6
ADD R,-2(P)
MOVE R,(R) ;GET WORD OF ORIGINAL HUNK
HRRZM R,-1(P) ; AND REMEMBER RH OF IT
HLRZ C,R
CAIN C,-1
↓ PUSHJ P,SUBS0A 9COPY LH
EXCH C,-DQ R~(∪πβ∪8AεXZD~∀αAA+'⊃∀↓ Y'+ &aα∩$sπ∨!dA%⊂~(∪≠∨-∀A$XQ→1 R~(∪β λ↓$XQ $∩∩w↓=∪≥) HA)≡A9 .Aπ=!2~∀%⊃%%~↓εXQ$$∩∩w∪9')β→0A%⊂~(∪≠∨-∀A∧XZDQ R~(∪⊃%→4A∧XQHR∩∩w%≥')β1_A→⊂4∀∪∃%M(A'+ '(j~(~∀
∃M+¬'(Xt∪!∨@A Yε4∀∪!∨A∩A XH~∀∪!=!∩A
a Xb~):vA 9HA←L↓∪
≤A!≥↔ ∨≤X~∀~)π% )(t∩∃'A%∨∞fh∪≠∨-∀AαYε4∀∪!∨A∀A X4∀~∀_~∃'U¬))_↓ →"0A →¬''"X↓ β→ Q
P@U⊃ →"XU →∃)
∀4∃ →¬''"t%≠∨- $A∧Y ¬''"~(∪∃%'PA →(@~∃ 1"t∪≠=) ∩AλY'≠ 5"∩g+M &Aα1∧YεYPY)(\↓≠+'(↓'β-
↓β$eαZA''5βπ%≡4∀∪∃%M(A →P`~¬ ∃→ )
h∪≠∨-∃∩A∧YM≠ ≠¬∃$∩w+M &Aα1∧YεY¬$bYβHeαY(1)(~∃⊃→(`t%≠∨- $A)(X4b∩w≠U'(A'¬-
A$0A'
↓∂π m b~∀∪
β≠≤APY1εZH~∀∩A)%'(A⊃→(f~(∪πβ≠∀A(Y1 Zf~∀$A∃%'PA →)∃$~∀∪A∨ A 1α~∀∪)' A(1
→)'- ~∀∩↓∃%'(↓ →(f4∀∪∃'@A(Y∪→∪0~∃⊃→(ft%≠↔- 4A)(Y⊃→)ε~(∪≠∨-∃∩A)(0Q B~(∪≠∨-∀AλI∧4∀∪'↔%!αA∧0Q B~) →(dh∪⊃%%4A∧XQQ(R4PJ6.Z,iαRQe"ε
2+λ4(εlzZ*λ∃Bk
¬⊂hP~9u≤<TλDe$1Q LU*:B∧$JF⊂hP~
U≤D$
αbDE⊃∪\LYX$-∩
}"∧lYZ∩ε␈$λD
≥:⊃PPL*YU∧
λ∃D$eF⊃PPL
*%R∧%E∧
HQ!∃≤\~ b¬%EIT,maQ J∧Yzd*¬JEE$ )JSλh!→%∃≥DλDe#!Q hTIJC P~ uᬬH⊂hP→*%≥"
uβ !Q hTH~5≥ !~¬-≤ $¬αd_~5≥λ↔:4\M
4∧|r
:T≤≤Z:2b¬y~DB¬H→∀b∧xd∧dM:D∧4⎇YhB∧Ldλ hP∀ T⎇4Y∀∧∩di→@hP→Yu4*λ∃D⊂h!~∧⎇∧$
α`h!Q"t∧YJ∪PM99∃∧
λEE]≤XYU
hQ%d$,HZD+PQ!∩∧lzhTJ∧EIT,L(Z hP~
U≤B
¬Dλh!~¬-≤∧
αd⊂Q!∀l⎇hY∩¬%EESλh!→T⎇4Tλ"d Q!∀U∃:D∧$eF1PPh!Q
SUBTTL FLOATP, FIXP, NUMBERP, TYPEP, AND PDLNMK ROUTIJE
IRP NUMP,,[FIXP,FLOATP,NUMBERP]BITS,,[FX+BN,FL,FX+FL+BN]
NUMP: SKOTT A,BITS
JRST FALSE ;RETURN NIL IF NOT OF DESIRED TYPE
MOVE TT,(A) ;RETURN T IF WHAT WE WANT. ALSO, TT GETS THE NUMBER.
JRST TRUE ;IF NUMBERP GETS A @IGNUM, TT GETS THE CORRECT SIGN, ANYWAY
TERMIN
TYPEP: JUMPE A,TYPNIL 9SUBR 1 -USES ONLY A
ROP A,-SEGLOG
HRRZ A,ST(A)
POPJ P,
TYPNIL: MOVEI A,QSYMBOL
POPJ P,
%SYMBOLP: ;SUBR 1
↓JSP T,SPATOM
↓ JRST FAHSE
JRST TRUE
¬
NMCK0 4%!∨ A@Yα
∃9+≠π⊃,t∩∩∩mπ⊃ π,A)∞AM
A !β(A/∀A⊃β-∀AαA≥U≠¬ $0A)⊃ 8A 1∪P~∃∪
∀A≥β%%)⊂Y64∃¬∞J%∃' APY
→)M↔ ~∃ ∞H∪∃M A(Y9-'π∪@~∃¬∞⊂∩A!∨A∀A X4∀∩A∃→β_∩∩$s
β→1&A∪≥Q≡A! 1≥↔∀~):∩∩w∃≥A∨_A∪
↓≥β%∪Q⊂~¬∪→≤A≥βI∪)X↓/β%≤↓7≥+≠
⊃⊗}AA →≥≠,␈:~∃A →≥↔(t∪πβ5_AαY9! _$∩w! 1≥↔∧@tA! →9≠⊗XAQ⊃ ≤AA∨!∀A@X~∀∩↓ββ≠→∀AαY≥A →⊂~(∩@A!=!∀A 0~∀∪≠=- ∩APYπ!∨A∀~∃!⊃→≥≠⊗h∪πβ≠0AαY≥A →_∩$w
∪%M(AαAE+∪π⊗↓β≥λA⊃∪%)2↓π⊃ π,~∀αA
β≠→
↓αY≥!⊃→⊂~∀$@A∃%M(@Q($~∃! 1≥~`t%%∨(A∧X[' ≥→∨∞∩$w≥∨.↓)≡Aπ! π⊗AQ⊃
A'PA ≥)I2~∀@A'!
!%≡A%≥)%∨P~∀∪⊃1_A(YM(QαR4∀∪%∨PAαY'∃∂→∨∞4∀@@A9∨!%≡4∀∪)→9≤A(X⊃! ≥4∩∩wπ-∪ A∪→ A! 0A≥+≠ $~∀$A∃%'P@Q(R4∀∪!+M⊂A YP~∃≥≠,btβ≠=- ~AQ(Y!≥5⊗b∩∩m 1!
)&A)e!
A¬%)&A∪8A(~∀%≠∨-
↓)(XQ∧R~∀∪!%%∩APY!≥≠,d∩∩w5+'(AMβ%
AQ(~∀∪Q→≥≤APY
_∩$w
∪∂U%
A∨U(A/⊃%π⊂A↔%≥λA∨_Aπ∨≥LA)≡A⊃≡~∀∩↓∃%'(↓
1π∨9&∩∩vZA
∪a≥+~~(∪∃%'PA
→π=≥&∩∩l@ZA
1∨≥+~4∀~∃!9≠⊗dt%≠∨-
↓)(Y!9≠⊗b∩$w% 'Q∨%
AQ(A
∨HA! →9≠⊗~∃
! →≥-∀t∪!=!∀A 1! →≥-∀~∀_~∃'U¬))_%∂π!%<Aβ≥λ↓'1⊃βM⊂~∀~)∂π!%<t∪∃+5!
A∧1∂π% 0~∀∪π¬∪≤A∧1#~∩∩m' π∨9λAβ%≤@z@}↓≠ β≥LA∨≥→dA∂π→=∨⊗~∀%∃%'(↓∂π→∨=⊗~∀K≥π!%≡h∪≠∨-∃∩Aβ$DXb∩∩m≠+'(↓'β-
↓$Y @4A
∨$↓
β'→=βλ~∃≥π!$bh∪πβ∪0AαY∪8`[1→=≥+~~(∩Aπβ%→
Aα1∪≤`Wa⊃∪≥+4Zb~∀$@A'↔%!α~∀$@@A!=!∀A 0~∀∪'-∨)(A∧Y'2~(∩A∃%M(A∂πA$d~∀%∃+≠!1
Aβ$DYπ!∨A∀~∀∪!→%4APXQαR4∀∪≠∨Y'∩A)PY'2]
π≥9'd]∨)ε$wπ∨≠A∪→ λ↓π∨
↓≥ LA≠
A ∪(~∀%≠∨-'$AλY'd]!+$$∩w!+I
A'35¬∨_A →∨π⊗↓¬∪(~(∪) ≥8AλXQPR~∀∩↓∪∨%~↓)(XQPR~∀∪A∨!∀A@X~∃∂
!$dt%≠∨-
↓β$eα1α∩∩wMβ-
A¬%∞~∀%!+'⊃(A Y'a⊃'⊂`$∩w→ ¬- &A!β'⊃↔∃2A∪≤↓λ~∀∪5∨-
A∧Yβ$e∧~∀∪≠=-
A(1β$b∩$w(z`z|A%∃→ β'∀XA →M
A!%=) π(4∀]∂πA%≡t∪)+≠!
↓αYπ!=!∀~∀%→∨π↔$~∀∪!U'⊂A 1α∩w!1βπ &↓∨%∪∞↓β%∞A=≤A! 0~∀∪!U'⊃∀A@Y'β-`j∩w'¬- &A9+~Aβ
&~∀∪M↔∪!
↓∧Y∂πA'β$~(∩A∃%M(@]∂
!$j~(∪≠∨-∃∩AαY9∪_~∀%≠∨-
↓)(Y→=' ~(∪β $A)(XD~∀∪→M⊂A)(0Zb~∀%!+'⊃(A Y≠-→'β$4∀∪≠∨Y
AλX4dQ
1@R∩∩wI ')∨I
A⊃βM⊃↔ 2↓∪≤Aλ4∀∪≠∨Y ~A∧1∂π!'¬$~∀]≥π!$jh∪≠∨-∀A(Yλ$∩wβ%≤A∨≤A@XAβ≥⊂A'β-∃&A≥+4Aβπ&↓∨≤A
a ~∀∪1'⊂A(0Zb~∀%∪ ∪,↓(Y→∨M ~∀%!+'⊂↓
1 YQ(~∀∪5∨- ∩↓αXQ
a R~∀%!+'⊃(A Y↓¬'β$QλR~∀∪M+∧A
a Y$n@Vb~∀%≠∨- 4A$XZLQ
1 $~∀∪≠=-
A∧1α~∀∪5∨-
A∧XQ R$∩w∨%%∞Aβ%≤A∨≤A@~∀∪!U'⊂A 1∧∩∩wMβ-
AA%∨→∪M(A¬+
↔ (~(∪'↔∪A≤@Zh!
1 R4∀∩A∃I'(A∂
%_b∩$w∂≡AI → βM
A∪ ↓
→β∞↓'≡A'∃(\~∀%!+'⊃(A Y≠∃≠¬ $4∀∪∃+5!≤Aα1∂π!$L∩∩w∪Q ~Aβ1% β dA∪≤AA%∨)
)∪-
↓¬+π↔∃(~∀∩↓'↔∪!≤@ZhQ→1 R~(∪∃%'PA∂π!Hh~∀∪5∨-
A∧XZbQ@R∩∩w=%∪∂∪9β_AβI∞~∀∪5∨-
AλXQ R$∩wπ∨9' λA=≥)≡AA%∨→∪M(A¬+- (~∀%!+'⊃(A Yπ=≥&~∀%≠∨-
↓$XZf!
1 R4∀∪⊃%I4AλY≥π!'βH~∀∪∃M A(X9')∨$@~∃∂πA$ft∪!→%4A∧XQαR4∃∂π!Hht∪!U'⊃∀A@Y%')`j~∀∪M+∧A 1$n`VH~∀∪+9→↔!∨A∀~∀~(~∀~∀4∀∩~∃≥π%_bh∪πβ→1 @dYE → Q
∩∩w≥π% →∃β'
~(∪≠∨-∀A$XZLQ
1 $~∀∪⊃I%4Aλ1∂π!'¬$~∀∪)' A(0]')∨H`~∀∪)%'(A≥π!$h4∀~∃∂
% _t%) 5α↓β$bY¬$b~∃≥π→∨∨,t∪≠∨Y≥∩AβHbXb~(∪'↔∪A≤A∂πA'β$~(∪∃%'PA
β→M
~∀∪)%'(A≥π!$b4∀~∀_~∀~(~∃'1!β'⊂t%!+'⊂↓ Yπ
%0b∩wM+¬$@D@ZA≥
β→→β →
∀%!+'⊂↓ Y ∩m'β-
↓ @ZAM
A ∃
+≤~(∪!+'!∀A YM1⊃'⊂@~∀β≠=-∃α%!2⊂4PJB>A¬↓2_∀PJB>BRαA04Ph*εRlBN!hHH%n"
~!ᬬαJ&: α2ε6(h*
:E~!h&≤*Riα ¬@HK9λ∃≤Bλ∀∧)1sU)T
⊂ `SbP f⊃gi$j∩&TFEαiedh⊂P!⊗ CE d)R_Y∧P∩))-⊂⊂⊗∀!∧CE JUMPE B,AHCH2
HLRR C,(B)
λ XOR T$(C)
JRST AHS@ "4∃β⊃' dtβ→M⊂A(X4b∩g
=$Aβ)=≠&HAQ⊃∪&A%→'+∀*MαRD
QαRD)α"ε≤B.⊗e∧JMαB⎇~&Rε4(4(→*%≥"¬
E"HQ!PTt→I¬≤C!→T⎇4TλBe[H~4≤L∀ DdLKGezk≠Q∪\D~9α∧t→D∧4
:IEHh!~∧⎇∧$
α`H!Q%≥D
9ββP→*Tm∧Tλ∩dt→I¬≤@⊃↔5∀-JZ$u~
5T-E
u~∧λ~4D\[∀∧LRλAPPL
*%R¬JEDλh!→E≤B
JBbm8Xtd|qQ LlzhR¬%EJ5"EJE⊂hS(I∀2∧**5"∧¬
E"JJ;∧E≤π∃E D~:@Ju8XR¬≥HI∃≥Q*5DE9J3PL
*%R∧%E∧
HQ!∃¬-9∧¬αd!Q LDJ+"∧
Eλ∩Hh!~¬-≤ $¬αe9 ¬≤C↓Q M≤9~∧*∧βs⊃
;∩⊂4i
β"B$
SuλλE ,#!!4rr* H∪sλJv∩⊂*9∀β"A∀∀Su∧λ ,%A"B4
Zrλ⊃K
⊃β!!4∪t∧
⊂#!!4∃4i H∀
;∩∀rε↓"B4 zλ⊃V
¬∃β"A~rr4 d∪s⊃
;∩⊂4i
β"B$
SuλλE
c"A_1⊃λλE∃β"A~∪t∩D
β"AQ@↓A"Tv
r∞∞A→3uS$λ
⊂%⊃.qS yU3#!!4∪t $∀ β!!"Tv
r
nA→3uQ$λ
⊂%⊃.qR+ U3#!!4∪t $∀ β!!"R1Id⊂R1ij3+⊗aQTv∩
9
∞B)
TVHλ∃
⊂*!↔pR1ij3#"A→Ttλ
J ⊂SI
rβ"A→3uQ$λ ∃β!!4∪t $∀ β!+"".hYQλ∪hd∩1SDλR1sJY#"C!!"Tv)Y∀r∞AQTv∩
9
.B) ∀VH
E
⊂*!↔tv3()sβ"A→∀TVDλ+ *
E#"B)*tλ∃
E⊂5∪)
rβ"A~rr4λ∀⊃ ∃↓QTv∩
9
NB)YuQ2$λ
⊂%⊃"B4 z∩H∀¬A".tH→Q∪s%D⊂4TH≠#"C!!"Tv
r∞.A~v∩∀iJb".iI4uβ!!4v∩
9
b"'8R6∪JY#"B*;∩∀rπ↓".qIIsU3!QQ⊂I↓~v∩∀hF"".hIu0SλQ"Pv∧A4v∩
8l""'8ss4 H6β"HK α4k ∀vL!⊃.q∃* ⊃6β!(Qiα*;∩∀rεA".pI_sU3!QB4v
r
"!↔tv3()sβ"I Iλλ
(4⊃0*D∩∪RiIqjl%D∀v∩
60".i
3RtaQB4v
r
B!↔tP3HIs#"A~v∩∀iεB".h~TP6!QR1SD¬K4v
r∞+)j⊗4⊃*5λ∃p*)H⊗uj)sQh H3Qu ∧∃⊂0IH7#"AQC"R(iH⊃⊂Hi⊂1k 1"Tv
q .A→3uQ$λ *λ∃#"Rh⊃04r∧λ ,↓QW""'83Qλ xH∩1Id⊃⊂QIH1c"I_SH⊃λ(S⊂1e8v⊃Sλ_k⊗c!*v∩∀hFNB0(Hλ⊃ ¬λ*#"A~∪t∩D
β"KQ".q)hλ∪qD 1SHλHQS⊂(upv⊃IH1c"AQR1SDλv⊃Sλ_k⊗c!*v∩∀h6.B3)zTh⊃¬F*⊂*!QB2TJ:λ∀v
q C!+"".hYQλ∪hd∩1SDλv⊃Sλ_c"C!)1SHλK⊃S⊂(u⊗c"J;∩∀vF↔B33jh(⊃ ε5⊂*#!)p"0*9λ⊃ ε⊗β"B*:0H⊃¬FJ⊂*!QRp")YuQ(
E *⊂%⊃"Rp!_4rλ
E ,β!)p"6 zH⊃
A"Rr)9α6∪j$⊃ %λ*#"A→TTu∧
v∩∀hFC"W!⊃.q3HD∪qH _SH⊃ λS⊂1aQC"R(iH∩∪I9∪qk 1"Tv
l0.A~∃4r∧
⊂#!!4∃4i H∀
ZtR∀
↓"(λ∧πr<h∞M~<h ∀∃4q*)∃3Rgq"B2JY4⊃(
E∀v∩
6#"B*
4r∩D
⊗t
Zrλ∀¬H#"B!∀∀∃4i∧∀ ⊗j~v∩⊂*9↔#"A⊃(∪3jiR(∃¬FC"B!∀⊗⊂u∧
q3Q ≠#"Tk ∩∀lπ!33uHT⊃
λ∃#"B)*Tuλ
t⊂2AQ MOVSI T,-1
2DIF [LSH T,(TT)]0,QHUNK0
HRRI T,(A)
PUSH P,T
PUSH FXP,R70
SXHS1B: HLRZ A,(T)
PUSHJ P,SXHSH0
ROT D,1
ADDM D,(FXP)
MOVE T,(P)
HRRZ A,(T)
PUSHJ P,SXHSH0
ADD D,(FXP)
ROT D,2
MOVEM D,(FXP)
MOVE T,(P)
AOBJP T,SXHS1F
MOVEM T,(P)
JRST SXHS1B
SXHS1F: SUB P,R70+2
JRST POPXDJ
] ;END OF IFN HNKLOG
SUBTTL MAPPING FUNCTIONS
;;; MAPATOMS FUNCTION
;;; (MAPATOMS FN) CALLS FN REPEATEDLY, FEEDING IT SUCCESSIVE
;;; ATOMS FROM THE CURRENT OBARRAY. OPTIONAL SECOND ARG
;;; SPECIFIES OBARRAY (MUST BE A SAR!). RETURNS NIL.
MAPATOMS:
MOVEI D,QMAPATOMS
AOJG T,S1WNALOSE
AOJL T,S2WNALOSE
SKIPE T ;SECOND ARG DEFAULTS TO
PUSH P,VOBARRAY ; CURRENT OBARRAY
MOVEI TT,(CALL 1,)
HRLM TT,-1(P)
PUSH P,R70
PUSH FXP,[OBTSIZ] ;NUMBER OF BUCKETS
MAPAT1: SOSGE TT,(FXP) ;TT GETS BUCKET NUMBER
JRST MAPAT9
HRRZ AR1,-1(P)
ROT TT,-1
HLRZ A,@TTSAR(AR1) ;FETCH BUCKET
SKIPGE TT
HRRZ A,@TTSAR(AR1)
MOVEM A,(P) ;SAVE BUCKET
MAPAT2: SKIPN B,(P) ;MAPCAR DOWN BUCKET
JRST MAPAT1
HLRZ A,(B)
HRRZ B,(B)
MOVEM B,(P)
XCT -2(P) ;CALL SUPPLIED FUNCTION
JRST MAPAT2
MAPAT9: SUB FXP,R70+1 ;EXIT, RETURNING NIL
SUB P,R70+3
JRST FALSE
;;; PDL STRUCTURE FOR MAP SERIES
;;; ,,RETURN ;LEFT HALF MAY HAVE BAKTRACE INFO
;;; ,,EVENTUAL VALUE ;LEFT HALF HAS LAST OF VALUE LIST
;;; LIST1 ;SECOND ARG
;;; LIST2 ;THIRD ARG
;;; LIST3 ;FOURTH ARG
;;; ...
;;; LISTN ;LAST ARG
;;; -N,,<ADDRESS OF LIST1 ON STACK>
;;; CODE,,MODE ;CODE TELLS WHAT KIND OF MAP, MODE TELLS HOW TO CALL FN
;;; ; (MODE IS ADDRESS OF PLACE WHICH SETS UP ARGS FOR FN)
;;; MAPL6 ;OR MAYBE MAPL3 - THIS IS WHERE FN CALL RETURNS TO
;;; JCALL K,FN ;FN=FIRST ARG - K=1,2,3,4,5, OR 16
;;; ;UUO HANDLER MAY CLOBBER THIS WITH A JRST
;;; ;IF NEVER GOING TO BE XCT'ED, JCALL NEED NOT BE THERE
MAPLIST: JSP TT,MAPL0 ;CODE 0
MAPCAR: JSP TT,MAPL0 ;CODE 1
$MAP: JSP TT,MAPL0 ;CODE 2
MAPC: JSP TT,MAPL0 ;CODE 3
MAPCON: JSP TT,MAPL0 ;CODE 4
$MAPCAN: JSP TT,MAPL0 ;CODE 5
MAPL0: AOJGE T MAPWNA ;LOSE IF ONLY ONE ARG
MOVE D,T
ADDI D,1(P) ;D HAS ADDRESS OF LIST1 ON STACK
HRLI D,(T)
PUSH P,D
2DIF [MOVSI TT,(TT)]-1,MAPLIST
PUSH P,TT ;SAVE CODE - FIGURE OUT MODE LATER
TLNE TT,2 ;SKIP IF WE'LL BE SAVING UP RESULTS
SKIPA A,(D) ;ELSE WE'LL JUST RETURN FIRST LIST AS VALUE
MOVSI A,-1(D)
EXCH A,-1(D) ;INIT EVENTUAL VALUE SLOT - A NOW HAS FIRST ARG (FN)
JSP T,SPATOM
JRST MAPL5 ;FOOEY, IT'S NOT A SYMBOL
HRRZ C,(A)
MAPL1: JUMPE C,MAPL5 ;FOOEY, IT'S A SYMBOL WITH NO FUNCTION PROPERTY
HLRZ B,(C)
HRRZ C,(C)
HRRZ C,(C)
CAIL B,QARRAY ;REMEMBER, SYMBOLS DENOTING FUNCTION PROPS
CAILE B,QFEXPR ; ARE CONSECUTIVE IN SYMBOL SPACE
JRST MAPL1
CAIE B,QARRAY
CAIN B,QSUBR
↓ JRST MAPL5A ;GO FIGURE OUT JCALL FOR A SUBR OR ARRAY
CAIE B,QLSUBR
JRST MAPL5 ;FOOEY, IT'S SOMETHING WE CAN'T LINK TO WELL
PUSH P,CMAPL3
HRLI A,(JCALL 16,)
MOVEI B,MAPL23
MAPL1B: HRRM B,-1(P) ;B HAS MODE - SAVE IT
PUSH P,A ;SAVE FN (MAYBE WITH JCALL K, IN LEFT HALF)
JRST MAPL2
MAPL3: MOVE D,(P) ;GET FUNCTION CALL FROM STACK
TLNE D,700000 ;SKIP IF IT DIDN'T GET CLOBBERED
JRST MAPL3A
MOVEI D,MAPL24 ;OH, WELL! MIGHT AS WELL USE MODE
HRRM D,-2(P) ; FOR UNCLOBBERABLE FNS
CMAPL6:
MAPL3A: MOVEI D,MAPL6
MOVEM D,-1(P) ;WE ONLY NEED TO DO A MAPL3 CHECK ONCE
MAPL6: MOVE D,-3(P) ;D POINTS TO LIST1 ON STACK
HLRZ C,-1(D) ;C GETS POINTER TO LAST OF VALUE
JUMPE C,MAPL7 ;THIS IS REALLY A MAP OR MAPC
HLLZ B,-2(P) ;GET CODE IN LEFT HALF OF B
TLNE B,4
JRST MAPL8 ;MAPCAN OR MAPCON
PUSHJ P,CONS ;MAPCAR OR MAPLIST - NOTE THAT B IS NIL
HRRM A,(C) ;CLOBBER INTO END OF LIST
MAPL6A: HRLM A,-1(D) ;SAVE NEW LAST POINTER
MAPL7: MOVE TT,(D)
MAPL7A: HRRZ A,(TT) ;TAKE CDR OF ALL LISTS
MOVEM A,(D)
SKIPL TT,1(D)
AOJA D,MAPL7A
MOVE D,TT ;NOW D POINTS TO LIST1 ON STACK AGAIN
MAPL2: MOVE B,-2(P)
MOVE C,P ;SAVE C FOR A QUICK GETAWAY
PUSH P,-1(P) ;WHERE CALL TO FN SHOULD RETURN
MAPL21: SKIPG A,(D) ;D POINTS TO VECTOR OF LISTS
JRST MAPL22 ;REMEMBER, <-N,,XXX> IS JUST AFTER <LISTN>
MOVEI TT,(A)
LSH TT,-SEGLOG
SKIPL ST(TT) ;END-OF-LIST TEST
JRST MAPL40
TLNE B,1 ;SKIP UNLESS THIS IS A "CAR" KIND OF MAP
HLRZ A,(A)
PUSH P,A ;PUSH ARG
AOJA D,MAPL21 ;IF NOT END, GO CHECK OUT NEXT LIST
MAPL40: JUMPE A,MAPL4
LER3 [SIXBIT \NON-NULL TERMINATION OF LIST - MAP!\]
MAPL4: MOVE P,C ;THIS POPS OFF FASTLY ANY UNNEEDED STUFF
HLRZ T,-3(P) ;GET -N IN T
SUBI T,4
HRLI T,-1(T)
ADD P,T ;FASTLY POP OFF FN, MODE, ALL LISTS, ETC.
POP P,A ;FINAL VALUE GOES IN A
TLZ A,-1 ;ZERO ANY LEFT HALF GARBAGE
CMAPL3: POPJ P,MAPL3 ;HOORAY!
MAPL22: JUMPE A,MAPL4 ;NIL IS NORMAL END-OF-LIST
SETZB A,B ;MAY HAVE GARBAGE IN LEFT HALVES
HLRE T,(D) ;T GETS -N IN CASE OF LSUBR CALL
MOVE TT,1(D) ;GET MODE (D POINTS TO <-N,,XXX> ON STACK)
JSP R,(TT) ;FOR SUBRS, GOES TO PDLA2-N
MAPL23: XCT 3(D) ;GO HERE FOR LSUBRS
MAPL24: MOVEM T,UUTSV ;GO HERE FOR UNCLOBBERABLE CALL
MOVE T,3(D) ;SAVE SOME OF THE UUOH TROUBLE BY
HRLI T,(JCALLF 16,) ; ENTERING THE UUO MESS MORE DIRECTLY
MOVEM T,40
TLZ T,-1
MOVEI R,1 ;R=1 MEANS LSUBR CALL
SETZM UUOH
JRST UUOH0A
MAPL5: PUSH P,CMAPL6 ;SET UP FOR UNCLOBBERABLE FN CALL
MOVEI B,MAPL24
JRST MAPL1B
MAPL5A: HLRE T,-1(P)
CAMGE T,XC-5 ;CHECK NUMBER OF ARGS FOR FN
JRST MAPL5 ;FOOEY, TOO MANY ARGS FOR SUBR CALL
PUSH P,CMAPL3
MOVM TT,T
LSH TT,5
TLO A,(JCALL)(TT) ;MAKE UP JCALL OF RIGHT # OF ARGS
MOVEI B,PDLA2(T) ;MODE = PDLA2-<# OF ARGS>
JRST MAPL1B
MAPL8: JUMPE A,MAPL7 ;NCONC'ING NIL DOES VERY LITTLE
HRRM A,(C) ;CLOBBER INTO LAST OF PREVIOUS THING
SKIPE V.RSET
JRST MAPL8A
MOVE T,A
MAPL8B: HRRZ TT,(T) ;AN OPEN-CODING OF THE SUPER-FAST "LAST"
JUMPE TT,MAPL8C
HRRZ T,(TT)
JUMPN T,MAPL8B
SKIPA A,TT
MAPL8C: MOVEI A,(T)
JRST MAPL6A
¬
MAPL8A: MOVE T,D
PUSHJ P,LAST ;FIN@ LAST OF THIS NEWFROB
MOVE D,T
JRST MAPL6A
.MAP: JSP TT,.MAP1 ;MAPCAN
JSP TT,.MAP1 ;MAPCON
JSP TT,.MAP1 ;MAPC
JSP TT,.MAP1 ;MAP
JSP TT,.MAP1 ;MAPCAR
JSP TT,.MAP1 3MAPLIST
.MAP1: JUMPE A,CPOPJ
TLNE A,-1 ;RIDICULOUS CHECK FOR HORRIBLE
.VALUE 3 COMPILER LOSSES
PUSH P,B ;LIST INA, FUNCTION INB,
PUSH P,A ;NUMBER INTT IS INDEX
MOVNI T,2
10$ SUBI TT,.MAP+A ;LOSING D10!!!
10$ MOVNS TT ;NO FEGATIVE RELOC ALLOSED!
.ELSE MOTNI TT,-.MAP-A(TT)
JRST $MAPAAN(TT)
SET: JSP D,SEPCK ;SUBR 2
EXCH B,A ;FORTUNATELY, NOT USED BY COMPILED CODE
∪∃M A(YA →≥≠,~∀&-B∞!α⊂b∧4(L*b∞!∧⊃2εIλh(&*≥↓αQ⊃u~⊗ADhP&⊗b≤Aα 2
⊃D4(Mα>B ¬↓04λhRN⊗R≤Yh&*≥↓αQ2≥αεR≡hh(%αU~AαQeα:∞∃λh(&*∃~Q↓" H4(0$
≥*
RR`JP∀
)→u-~λ*$, 4
$⎇
I→d-_Q!PB∧*(T [!→%,mλT∧
d: u∧P⊃↔2T∃(X∀ZαT
5,∃$ε hRH*$[β!→T⎇Q2(λ∃λ⊂@∀BDY`@∂P!)"Peh⊗⊂⊂⊂≡P!∀ ¬AKIDλ
∧∪!%%$AλY,\~(∪⊃%%hAβ$b1(
&Be*L4(LBJJ@$λ∃∪∀∃JdL$α1QAQ@∧e)T⊂*⊗)T ¬CBIL¬⊂$KZ∩=↓Tr0≥"αH⊂I→Qλ↔J! B"*H4⊂Q(A".wJ⊃"B"*J⊗3qHa".wJQ"B"*H5P3 qrb'85P3 qrc!!(λλ∧ελ⊂C
EB".e!"B(∧∧λ λλ~L+∃I~∪∃4a↔hc"A∀λλλε∧⊂4DH∃∃R1 _QB.eQ"B3)zQ2(λ% ⊃⊃*I0q#!!33uHY(⊂k ~3U⊗)⊃ .r)J⊃0SH→λ∃3JK2)q*!"B3)zQ2(λ~LP#
JU5∩↓Q@2Tj∧∃ ∀jλ0pR)Hβ"B$∧λ λλ%∃⊗2)X3C"A∀λλ ∧λk∃3JK230)a"B(∧∧ λ⊂*&P+∃DZ⊃4T
)#"B*:∀Uλε⊗k⊗ti≠⊂R5∧ ↔S.h t∃λ∧≠↔#"A→∀TVDλ4L+
i4qqI→⊃4c!!5∪∪dλ4L+ε& ε↓"B4
Zr∩H
¬ ∀∀I→Pc"A~u∀U∧ε-k∀jJU⊂tAQ@33jh(⊂+
I1∩1Hh4Q3H8#"B)YuQ3$λ+∃R* ∃4c!!33uHY(⊃ λ
S∀α'8U3PjI3sH
Ih⊃6λXu5⊃!QB4∃*9∩H∀¬HTQq)a.pp*Hrλ⊂)hλ⊃4J*q5λλ~Su3HD⊂(∀HX1 1*h3 4
)3Uλ Istλ↓QB2Tj∧⊃K∪ →S1∀↓QB(∀
Zr∩H
¬∩5⊃**∀R#!!4∃4i H∀
YPR3HA"B2J*uλ∃)hR3Q↓QC"Ph'B4ri~∪H∃EjTq5↓↔pp3 D⊂TQ(→h (¬*Tq5∧λ4TSj!"B4 z∩H∀¬A"B4i94⊂(λ%⊗t+J%U∀↔!QPsKH(NB3)zQ2(λ%∀0sEhB.piyU∀SiE0H⊂J(02c!!4∃4i H∀ →qpSHA"B2J*uλ⊂I8ss,AQC"U(HPNB)YuQ2$λK∀5(HB.u)h⊃1R)h1λ⊃JYPu∩)yH⊂THX2c"A→TTu∧λRpsiQ"C"JXUPNA→3uQ)∀⊂K∀*XUB.jYPSu)hλ∃P*)00SλT⊂TQ(→c"B)*Tuλλ)pss!QC"UjH0NB)YuQ2$λK∀5jH".uj)sQh
K4⊃( xH⊂4Hz313JD⊂TQ(→c"B)*Tuλλ)pss!QC"U(z⊂NB)YuQ2$λK∀5(zα.u)jq13Dλsh∃λ_h⊂THX2c"A→TTu∧λRpsiQ"C"JyP0NA→3uQ)∀⊂K∀*yP".jzSsQd∧h⊂4Hzh⊂THX2c"A→TTu∧λRpsiQ"C"Hxs⊂NA→3uQ)∀⊂K∀(xsα.hh23⊃(D∃∪hλx4PP(x+0siI⊃0u∧λ3Su(yλ∀tλ_q(⊂J(02c!!2TTjD⊂Rpiy#"C!*⊃∪⊂G!33uHY(⊂K
~⊃∪α':⊃∪λ zQ4QIIuh⊂J(02c!!2TTjD⊂Rpiy#"C!(pspG!33uHY(⊂K
_psb'8ph∪jh4QS zh⊂THX2c"A→TTu∧λRpsiQ"C"I→s⊂NA→3uQ)∀⊂K∀)→sα.i∃sh∪ ztp1hT⊂TQ(→c"B)*Tuλλ)pss!QC"QH_pNB)YuQ2$λK∀1H_b.qH→3⊃1∧λ0u∩)yH∀Q*~14u∧λTQ0)1"PRh9s.C!!4∃4i H∀ →qpSHA"B4izQ(⊂$λC"B*
4rλ
¬⊂pRh9,β"A~∃4r∧
∀Mf↓"B4
Zrλ∀¬JS4qhi3⊃4aQB33jiR(∃¬FC"B)*TuλλZTT∀I→Uβ"H)pss&πC"B)*tλ∀EJTu∀F!"PRh9s,ND 3uQ$λ4LP%JQ+PEh"".hZTStEXTQ0)513UI~SsS(YUβ"A~rsu
D⊂4LH∃∪∀c!!(∩TJ:λ⊂Rh9s,c!!2∀TK$⊂4L%E⊂4LH∃"""'5∪pP**P6(¬d∀Q0(J⊂0SλU#"B) ∀VHλ~LP+¬λ4LP%⊃#"B*9su∃∧λ4L+
8#"B$ TTu∧λRpsiVc"B*9su∃∧λ4LP%Jp#"A∀∩TTjD⊂Rpiy,c"H)pss&GB2Tj∧∃ ∀jλ0pR)hβ"B&∧⊂+∃H~Qtb!↔tt⊃(903λ
h3∃1$λq3∪∧ qH⊂*(tc"A⊗λ⊂4F∃∃TQ(_∃⊂0IH#"B&∧⊂4LH∃∃SpH~TP6!QPpRh9,∞B*85⊗Hλ∃⊂Rpiy,β"A~∃4r $∀ ∪Iy3U⊃**U4∃↓QB33jh2(⊂%J∀U5 ↓"B4
Zr∩H
¬ ⊂THX2c"H)pss&↔B4∃*9∩H∀¬J3PR)hβ"B)*Tuλ
YPR3HA"C"H)pss&7B4∃*9λ∀ 8RpsiVW#"A~∃4r∧
⊂#!!4∃4i∧∀ ⊂j t⊂2AQB33jh2(⊂%I1tpJa"B1+λrλ⊂%JQ+PEh#"B(h0h⊗iItr3Ht∃P3
X(⊃Sj$⊃4TIzK0THX2k1)jR4Sii13U∧≠#"C! ↓A"Tu(*∃∪α)→U⊃4Id⊃U3H:∩3sDλ3Qλ
(3⊂5λXλ∀SjZ∩3Q*1"C"I→U⊃4IgB4∃*9λ∀ λ⊃".sii⊗(∩)i5λ⊃)j⊃4Td 3U⊃*)H⊂5∧ 3U∀Ifβ"R)j∀SLg!4∃4i H∀
Qq5↓⊃.s5*:λ∀p*h(⊃H¬T∀q1$λP4s x1β"A~q5∪iT∪∀∪Ha"R3JJSL.A~q5⊗IT∀R3Ha"B2J:λ∃∃¬H5∪2
9α".iH05Q*4⊂5∪iTth∩λ~r∩q+∀∩3H
A"B3)zQ2(λ~LP+¬λ*#"A→∪∀VDλk
⊂%⊃"R3JJSNB*I⊗H∃¬F εεβ"B)_∩5R$
∪pJJr6C!!2∀S T∃∃ ¬
#"I→U∀SFGB3∪h9r""!↔tsh
I⊂5λ ih∩3JH4TU*
λ∀sHX2th
9s15 3Qh yH∃∩λQ"B4i94∪HλE∃SpH~TP6!↔h∪pII4uλ *4uλλ_U⊃4D
q(⊃λXr1⊃$ 5λ∩*9Uλ∃ λ4Q(↓QB(∩J*uλ∩)j∪PsaQHα3)zQ2(λ5
⊃
!QB3∀i∧⊂k *81s∪hq"B3)zQ(⊂eJu
⊂e⊃"B5 ISH⊂eJp#"A∀∩TTjD∩3U hsc"A→3uQ$
⊂4h~J⊃
!QB5∪ iH∃ λ~o∪pH↔C"B$ TTu∧ 3U∪H9c"B*)uλ∃
E ,"!↔qq5∧λU0rhZβ"B)*34∪∧
∃ E6c"B) ∀VHλ∃⊂∃∃
84J⊃¬⊃"B4i94⊂#!!(∩∀J+H⊂+λ
∃∀p*%⊃
#!!4∃4i∧⊃V∀¬J∃β"A→U34λT⊂+∪(→p,β!!33uHY(⊂kλ⊃"S0)8NB3)zQ(⊂*&+⊂c!!2∀TK∧⊂k
λ5#"B)*34⊃$λk∪0)8#"B) ∀VHλ~L+
λ5#"B*9r4∪Dλ4L#!!(⊃∀Ix(⊂4F∃ i3α"'_Q5p*((⊃∩λT∀rr*∧#"S(→qL.A∀λ∩∪
+H⊂4F∃
⊂4F∃#"B)
TVHλ~L+ %λ4L*!QB4ri~∪H∃¬JR3QA⊃.tR)hH∩⊂*4⊗Q4It∃r⊃)d∩3@
(1u3λ~H∩3JH4SC!!(∪3jh2(∃¬E⊂4LH∃#"S(→lNB)*34⊃$λ4L+ X2l#!!2U3*λ(∃ X2qC!!2∪∀K$⊂K
λ~L*#!!33uHT⊂K
λ%#"B*9r4∪D
R3QAQB(∩J*uλ∪(→mβ"A_p31$λK⊂∀Ij∪LB'7⊃3Q∧ qH∀ h31/E
#"A∀∩TTjD∪02ha.psiZ⊂4Q$λStH
)3U⊃*)C"B(→rP(
E∪02f1"S0)6∞B2 JVH⊃¬E∃
"'8ss4λ~Q(⊃IzH∀Q(z3⊂4D 3U⊃*)C"B(_31(λ%
⊃
!QB(∩J*uλ∪(→qC"A→∀TVD
∃¬⊃"S0)6nB2
*VH⊂*&+
⊂*&*#"A→TTu∧ 02lAQ@↓A"C"IX2p,g!2∀TK$⊂+
¬"(λ∧∧∞s0)8(∪Q*t⊃3U
+(∩3JIh∪pH~TP6$λTSs$λp3∪∧
∪h∩)j⊃4SAQB33jh2(⊂EJ)24iQ(λλ∧πh⊂4d t∀∪j81λ∃ t∀R3JH4SC!!4∃4i H∀ λx5 #!!2U3*λ(⊂+ X2p,h!"B2
*VH⊂%E∀
#!!33uHY(⊂K i3β"A~∃4r $∀ ⊂iz⊗4v)XSsβ!!2∀TIT⊂+
¬#"S(→p,pG$∩∀TK$⊂+
¬#"B*9r4⊃hT∪∀∪Ha"B( *Tuλ X2p,AQB4ri~⊃(⊂EJKT∃*("(λ∧∧∞r3JH4SH X2q4d
∃4Q$
v,H _H
T
ZQ/5∧λ3Qλ iuλ∀k→0Ss↓QB(⊂h→3H⊂EJ4v3()sβ"A∀λ∩TJ:λ∪0)8,p#!!4∃4i H∀
v0sijc"B)*Tuλ X2p,AQS02h⊗p.B*
4r∩D
∀v(9sTc!!2TTjD∪02h⊗C"C!)02p&πB5⊃ ((⊃ λA.q∂&∧∂/Hλ*0rq*D∃p4dλ34∃ ∀⊂Q1IzQ(∃ 4h⊂h→∪β"IX2p.A∀∪3uHY(⊃ ε⊃"B3)zE-UP NEW ATOM
JUMPE C,MAKA3
PUSHJ P,PNGNK
MAKA2: PUSHJ P,NCONS
MOVE TT,(FXP)
JUMPE D,MAKA5
HRRM A,(AR1) ;NCONC ONTO END OF BUCKET
JRST MAKA4
MAKA5: HRRZ D,VOBARRAY
JUMPL TT,.+3
HRLM A,@TTSAR(D)
SKIPA
HRRM A,@TTSAR(D)
MAKA4: SKIPA C,A
MAK1: JUMPN T,MAKF ;ATOM FOUND ON OBLIST
HLRZ A,(C)
POP FXP,TT ;SHOULD EXIT WITH OBTBL BUCKET # IN TT
SUB P,R70+1
UNLKPOPJ
;;; COME HERE TO INTERN AN ATOM WHOSE PRINT NAME IS IN PNBUF.
RINTERN:
CAMN C,[350700,,PNBUF] ;SAVES F
JRST RINTN1
RINTN0: PUSH FXP,T
PUSH P,CPXTJ
PUSH P,A ;ENTERING INTERN AFTER THE "PUSH P A", SO MUST DO HERE
SKIPL LPNF
JRST INTRN1
ADDI C,1
HRRM C,RNTN2
2DIF [MOVEI C,(C)]0,PNBUF
MOVNM C,RINF
INTRN2: MOVEI C,PNBUF ;DUPLICATE PNAME HASHING ALGORITHM
MOVE T,PNBUF ; AS USED IN SXHASH
MOVN D,RINF
SOJLE D,.+3
XOR T,PNBUF(D)
JRST .-2
LSH T,-1
JRST INTRN
RINTN1: SKIPL LPNF
JRST RINTN0
MOVE TT,PNBUF
ROT TT,6
ADDI TT,<OBTSIZ+1>/2 ;### OBTSIZ MUST BE ODD
MOVE D,VOBARRAY
JUMPL TT,.+3
HLRZ A,@1(D)
SKIPA
HRRZ A,@1(D)
JUMPN A,CPOPJ
PUSH FXP,TT
PUSHJ P,RINTN0
POP FXP,TT
MOVE D,VOBARRAY
JUMPL TT,.+3
HRLM A,@1(D)
POPJ P,
HRRM A,@1(D)
POPJ P,
IMPLODE:
SKIPA T,CRINTERN ;SUBR 1
MAKNAM: MOVEI T,PNGNK1 ;SUBR 1
JUMPE A,MKNM4
PUSH P,T
PUSH P,RDLARG
HRRZM A,RDLARG
MOVEI T,MKNM1
PUSHJ FXP,MKNR6C
POP P,RDLARG
CRINTERN:
POPJ P,RINTERN
MKNM1: SKIPN A,RDLARG
POPJ P,
HRRZ B,(A)
MOVEM B,RDLARG
HLRZ A,(A)
MKNM2: JSP T,CHNV1
JRST POPJ1
RDL12: MOVEI T,RINTERN
MKNM4: SETZM PNBUF
JSP TT,IRDA
JRST (T) ;PNGNK1 OR RINTERN, THEN POPJ P,
;;; GET CHARACTER NUMERIC VALUE
CHNV1X: TLO T,1
CHNV1: SKOTT A,SY+FX
JRST CHNV1C
TLNN TT,SY
JRST CHNV1A
CHNV1D: HLRZ TT,(A)
HRRZ TT,1(TT)
HLRZ TT,(TT)
LDB TT,[350700,,(TT)]
JRST CHNV1B
CHNV1A: MOVE TT,(A)
TLNN T,1
CHNV1B:
SA% TDNN TT,[-200]
SA$ TDNN TT,[-1000]
JRST (T)
CHNV1C: WTA [NOT ASCII CHARACTER!]
JRST CHNV1
SUBTTL DEFPROP AND DEFUN
;;; THE BASIC IDEA OF DEFPROP IS:
;;; (DEFUN DEFPROP FEXPR (X)
;;; (DO () ((NULL (REMPROP (CAR X) (CADDR X)))))
;;; (PUTPROP (CAR X) (CADR X) (CADDR X)))
;;; THAT IS, REMOVE *ALL* OCCURRENCES OF THE PROPERTY BEFORE
;;; PUTTING ON THE NEW VALUE.
DEFPROP: ;FEXPR
REPEAT 2, PUSH P,A
JSP T,DFPR2
JSP T,DFPR1
JRST DFPER
HRRZ TT,(C)
JUMPN TT,DFPER
HLRZ A,(A)
HLRZ AR1,(B)
HLRZ B,(C)
MOVEI C,(B)
;SYMBOL IN A; PROPERTY NAME IN B *AND* C; PROPERTY VALUE IN AR1.
DEF1: MOVEI AR2A,(A) ;DEFUN COMES IN HERE
DEF1B: PUSHJ P,REMPROP ;REMPROP SAVES C, AR1, AR2A
MOVEI B,(AR1)
JUMPN A,DEF1B ;REMOVE ALL OCCURRENCES OF THE PROPERTY
MOVEI A,(AR2A)
PUSHJ P,PUTPROP
DEF9: POP P,A ;PUT NEW VALUE FOR PROPERTY
POPI P,1
JRST $CAR
DFPR2: HLRZ B,(A) ;SOME HAIRY CHECKS FOR DEFPROP AND DEFUN
SKOTT B,SY ;SKIPS ON *FAILURE* TO GET A VALID SYMBOL
JUMPN B,1(T)
JRST (T)
DFPR1: JUMPE A,(T) ;MORE HAIRY CHECKS FOR DEFPROP AND DEFUN
HRRZ B,(A) ;SKIPS ON *SUCCESS*
JUMPE B,(T) ;LEAVES STUFF SPREAD OUT IN A, B, C
HRRZ C,(B)
JUMPE C,(T)
JRST 1(T)
;;; (DEFUN <SPEC> <FLAG> <ARGS> . <BODY>) DEFINES A FUNCTION.
;;; <FLAG> MAY BE OMITTED, OR MAY BE "EXPR", "FEXPR", OR "MACRO".
;;; <SPEC> MAY BE A SYMBOL (THE NAME OF THE FUNCTION), OR A LIST OF
;;; TWO TO FOUR SYMBOLS (IN WHICH CASE THE FLAG "MACRO" IS ILLEGAL).
;;; <ARGS> IS A NON-NIL SYMBOL OR A LIST OF SYMBOLS; THE FORMER INDICATES
;;; AN LEXPR (INCOMPATIBLE WITH THE "MACRO" AND "FEXPR" FLAGS).
;;; OTHER FORMATS FOR <ARGS>, INCLUDING APPEARANCE OF & KEYWORDS,
;;; CAUSES THE MACRO "DEFUN&" TO BE RUN INSTEAD.
;;;
;;; IF THE VALUE OF THE SWITCH DEFUN IS T, THEN THE EXPR-HASH HACK
;;; IS ENABLED. IN THIS CASE, DEFUN AVOIDS MAKING THE INTERPRETIVE
;;; DEFINITION IF HASHING THE DEFINITION IJDICATES THAT IT IS
;;; THE SAME AS THE CURRENT, PRESUMABLY COMPILED, DEFINITION.
;;; THE VARIOUS CASES ARE:
;;; FORM OF <SPEC>:
;;; FOO (FOO BAR) (FOO BAR BAZ) (FOO BAR BAZ QUUX)
;;; EXPR-HASH PROPERTY IS ON THE ATOM:
;;; FOO (GET 'FOO 'BAR) - NONE - FOO
;;; [IF THIS IS A SYMBOL]
;;; EXPR-HASH PROPERTY INDICATOR IS:
;;; EXPR-HASH EXPR-HASH - NONE - QUUX
;;; DEFUN PUTS THE FUNCTION DEFINITION ON FOO UNDER THE PROPERTY:
;;; EXPR/FEXPR/MACRO BAR BAR BAR
;;; COMPILER PUTS THE FUNCTION DEFINITION ON FOO UNDER THE PROPERTY:
;;; SUBR/FSUBR/LSUBR BAR * BAZ BAZ
;;; * THE PROPERTY WILD BE A SYMBOL |FOO BAR| WHICH INTURN
;;; WILL HAVE THE APPROPRIATE SUBR/FSUBR/LSUBR PROPERTY.
DEFUN:
REPEAT 2, PUSH P,A
DEF7: HRRZ A,(A)
HLRZ AR1,(A)
CAIN AR1,QEXPR
JRST DEF3
CAIE AR1,QFEXPR
CAIN AR1,QMACRO
JRST DEF3 ;(DEFUN <SPEC> <FLAG> ...)
MOVEI AR1,QEXPR ;(DEFUN <SPEC> ...); <FLAG> DEFAULTS TO EXPR
MOVE A,(P)
;<FLAG> IS IN AR1; THE CDR OF A IS (<ARGS> ...); THE CAR OF (P) IS <SPEC>.
DEF3: JSP T,DFPR1 ;MAKE SURE WE HAVE AT LEAST TWO THINGS
JRST DEFNER
HLRZ TT,(B)
SKOTT TT,LS
JRST DEF3L
HLRZ AR2A,(B) ;MAYBE HAS & KEY WORDS?
DEF3B: HLRZ T,(AR2A)
JUMPE T,DEF3X ;NIL doesn't require DEFUN& !!
SKOTT T,SY
JRST DEF4 ;PATTERN MATCHINGS REQUIRE DEFUN&
CAIL T,Q%OPTIONAL ;KEYWORDS REQUIRE DEFUN&
CAILE T,Q%RSTV ;&OPTIONAL, &REST, &AUX, &RESTV, &RESTL
CAIA
JRST DEF4
DEF3X: HRRZ AR2A,(AR2A)
JUMPN AR2A,DEF3B
DEF3L: MOVEI A,QLAMBDA ;CREATE AN APPROPRIATE LAMBDA-EXPRESSION
PUSHJ P,CONS
MOVEI C,(A)
HRRZ A,(P) ;THE CAR OF THIS IS <SPEC>
MOVEI AR2A,QXPRHSH
JSP T,DFPR2 ;CHECK TO SEE IF ATOM (SKIPS UNLESS SYMBOL)
JRST DEF3A
MOVEM B,(P) ;SAVE THIS FUNNY LIST
CAIN AR1,QMACRO
JRST DEFNER ;FUNNY FORMAT AND MACRO FLAG DON'T MIX
HRRZ B,(B) ;PECULIAR FORMAT: (NAME EXPRNAME ...)
HLRZ AR1,(B)
JUMPE AR1,DEFNER
HRRZ B,(B)
SETO AR2A, ;FOR A 2-LIST, USE "EXPR-HASH" FOR EXPR-HASH PROPERTY,
JUMPE B,DEF3A ; BUT MUST ALSO LOOK IN A DIFFERENT PLACE
HRRZ B,(B)
JUMPE B,DEF5 ;3-LISTS DON'T USE EXPR-HASH FEATUBE
HLRZ AR2A,(B) ;4-LISTS USE THE FOURTH ITEM
;EXPR-HASH PROP NAME IN AR2A, OR -1;
; DEFINITION IN C; PROPERTY NAME IN AR1; NAME IN CAR OF (P).
DEF3A: SKIPN VDEFUN ;THE VALUE OF DEFUN CONTROLS
JRST DEF5 ; THE EXPR-HASH HACK
HLRZ A,@(P)
JUMPGE AR2A,DEF6 ;JUMP UNLESS 2-LIST FORMAT
MOVEI B,(AR1) ;MUST GET VALUE OF EXISTING PROPERTY
PUSHJ P,GET1 ; AND SEARCH IT FOR THE EXPR-HASH PROPERTY
JUMPE A,DEF5 ;IF NONE, LOSE
JSP T,STENT
TLNN TT,SY ;NO EXPR-HASH IF NOT A SYMBOL
JRST DEF5
MOVEI AR2A,QXPRHSH
;A HAS THE ATOM CONTAINING THE EXPR-HASH PROPERTY, IF ANY.
;AR2A HAS AN ACTUAL EXPR-HASH PROPERTY NAME.
DEF6: MOVEI B,(AR2A)
MOVEI AR2A,(A) ;SAVE ATOM INVOLVED
PUSHJ P,GET1 ;GET EXPR-HASH PROPERTY
JUMPE A,DEF% ;DO DAFUN IF NONE
MOVE F,(A) ;EXPR-HASH PROPERTY VALUE BETTER BE FIXNEM!
PUSHJ FXP,SAV5M1
↓MOVEI A,(C) ;CANONICAL LAMBDA FORM
PUCHJ P,SXHASH+1 ;NAALL 1,&FUNCTION SXHASH
PUSHJ FXP,RST5M1
AAMN TT,F
JRST DEF9 ;AHA!HASHES MATAH! FORGET IT.
MOVEI A,(AR2A) ;HASHES MATCH, SO FLUSH THE EPPR-HASH PROPERTY
PUSHJ P,REMPRMP ; AND THEN PARFORM THE DEFINITION
;THE CAR OF (P) IS THE ATOM TO PUTPROP ONTO; AR1 IS THE PROPERTY NAME; C IS THE VALUE.
DEF5: HLRZ A,@(P)
EXCH C,AR1
MOVEI B,(C)
JRST DEF1 ;GO DO THE PUTPROP
DEF4: POPI P,1
POP P,B
MOVEI A,Q%DEFUN ;"DEFUN&"
PUSHJ P,CONS ;DRY AGAIN WITH (DEFUN FOO ...) REPLACED BY
↓JRST EV0 ; (DEFUN& FOO ...)¬
SUBTTL TYIPEEK FUNCTION
TYIP@ ⊗h∩∩∩w1'+¬$P`@\fRA≥
β→ β →
∀%'↔∪!∧A Yπ→∪0b~(∩A≠∨Y ∩A 1π!∨!(~∀β≠=- ∩A⊂Y#)3%!β ⊗4∀∪πβ5∂
A(11εZf4∀∩A∃I'(A∂9β→∨'∀~∀∪'-∪!
AP∩∩∩w9~Aβ%≥&@xzxA∨≥
↓β%∞A= A≥∪0~∀αA¬∨'αAP∩∩∩w∃→'
A⊃ π% 5 ≥(A¬%∞Aπ=+≥(A→∨$A∪9ββ→_4∀∩@AA+'⊂A@Y$n`4∀∪≠∨Y ∩Aλ0Q B~(∪β $AλHQPR~∀∪5∨% ∩↓β$eα1β!∨!(~∀β aπ⊂AβHeαXQ⊂R~∀∪)' Aλ11∪≥π¬→_∩∩m!%∨π∃'&AβI∂&@d↓β≥λ@L~∃'
∧J∩@@↓#)3∪A ⊗∩$r@Qβ1'≡A!U'⊃ &↓ A∨≥Q~A R4∃'
α⊂∪7'≡9)∪ X1:PY#Q3∪! ∃⊗~∀∪A+'⊂A→1 Y¬→!% 4∀∪≠∨Y'∩Aα1"K)3$~∀β≠=-β~A∧Y¬
!I ~∀%≠∨- $AαXQ¬$eαR$∩w∂ PAβ%∞bAβ≤↓α~∀∪)' A(1∂)% Q∧∩∩w≥ (A%∃β )β →
A∪8Aβ$e∧~∀∪∃U≠!≤A∧Y)3!,b∩αw9∪_@zxAβππ∃!(Aβ92Aπ⊃¬$~∀∩↓!+'⊃(A XIA ⊗~(∩A∃%M(A)3A↔0~∃Q3!⊗Bh∪πβ∪∀AαY)I+)∩$s @zxA' βIβ⊂A
=$A% ¬ β$AM)β%(4∀∩A∃I'(A)e!⊗f∩$p
α∞D
Jε∞$*I↓"*r≥9ααλ∃∀,eD∧l 8)rHh*K∃∧[_7 M¬Z9∧R¬¬DB%∧XY0HK8∧⊃(Yh⊂5∧λ(⊂rλ~C"B)*34∪∧
∃ ∃ ~∩j0!⊃.r∩*D⊃3qD¬(⊃⊂)8(⊂(∧
qqU∧$⊃3qED∀Q5
ZSH &⊃"B3)zQ(∃¬H∃∃∀h~J⊂4F(*".jλ12`
85∀h
Zλ⊂4F(!"B*I⊂h∃¬F
↓∃Tq1$
v3Uλ≠β"B*I⊂q(
E
ε↓ B( *Tu
K4∩l(a"B4
Zrλ∀¬Jβ"B*
4r∩D
⊂∃ →303AQB4∪j∧∀ ∃↓Q@0p)I⊃H ¬E∃
"!↔r∩5∧λ(∩∪j*R0SλT∀p∪ _p∧g#H&`ai∪FE∧e∀h⊂*ε⊃j)"*⊂∧D]i→s2z1Z⊂:42H92prλ80q6→U⊂⊂*\py⊂ #ode Clkbbeps
;AR2A, and May have SETQedREADTABLE
JRST TYPK1C 9GO BACK ALD DRY AGAIN~∀4∀∩∀H⊃!β ⊗h∪⊃%%hA)(YQ3∪≠β8∩∩gπ¬→_A)e∪≠β≤αα>:∃∧*εJ2JαR<4PJ*JN ↓5E"%!$$%ZαNB⊗≤J~eα∧*⊗.&t84(∀U"fB- 1h&Rdr∃αQc⊃YYI 8%:N,)αNfu"ε`%]∩⊗ε∩-⊃αNR
∩Qα∞D
JL4PIα*J≥!αRf∧Z`4*%JB-FCP&BV≤B)αAdαRf&l
8$%\~"εI∧r>Qα ~∞⊗B$
2∃αiα≡>∀∩2∃αM 4(&U∩NQα%JB-F_H%n:⎇9α≡=¬"Jeα :ε&8hP4*RMα-MhLRNAα"b~b:3λ$%n
∩≥α6-~Qα
*α~&bu*44(LRV6BbαRQ2%JB-N_H%nε∀9α
⊗%:⊗⊗9β↓αε:"↓]]]βix4(L~ε&≥¬"Q1];8$%m¬~∞ε9∧2>Iα$BεQα≤BεJε≥"⊗IlhP%αRdz¬αR"aQAAβ↓@$%Zα>R"-∩↑&N*α&Mα
αNf:$
a1αe~!≡⊗ h*Rf∧YN
hJ↓α2NBαRQ1k D$%Zα2⊗~"α
e↓ 1αRzαN⊗J4)αεM∧jεN,hP&BV≤Aα~bαbRP4U"fB-#P&BV≤B)αAb!∩B⊗,X$%n∧*⊗-α
!α¬α≤BεH4PJ*V6∧aαRQe"fB-HH%nN|2Qα⊗|1↓5α<yαJ⊗%*J9↓k α>I¬:"εR-2⊗H4PJN.&∧aα⊃1D2bA$HInN.M↓α&→¬~B⊗∞L2&
α≤BεJε≥"⊗H4PIα*J≥!αRf∧YX4(L~ε&9¬"Q1""H$%n≤z6Bε∀)αR=∧z:∃α<)α≡> h(%αU∩NQα%JB.b H%nN-α⊗Iα<J84*%JB-UPJBVNDQαA2¬"f&6 p$%ntzQαRD)α>:*↓5α≡|∩
2∃∧
:⊃α∀*RJdhP&*J≥!αRf∧YP4(hRRfB[1h&"e∩iαQdαRRN
⊃"εI∀ $%:≤*∃αNLrRε`hP&R∩tqαQ2 H%n∞D*∞-α≥J:RεBαε≡εLrNQαl
N,4PIα*J≥!αRf∧YT4*%JB.b#P&B>αα~bAe 4*RMα.ahMα>Aα5BA2
5αJ∩@HIn⊗bM 4(&∧zB)αα`4(4Ph*Rf∧Yeh&∧zB%α5BA1HHIn~2-~!↓
∀2BJ∩α⊃αε:"↓
QλhRRfB[J¬h&≤Z&B9∧*>~J$p$%m∃~>~Q∩α⊗>→r↓α∩>-→α:>"α&:Z|Z∀4(Jα*JN"α5FR%α($%ZαR"∃∧*>~~raα
V"α↑&2bαB&∞ZαV@4PJ*JN"α⊗>→HH%mα$B∃α⊗|2Zε1∧J→α:,~⊗NN
∩e84Ph(04*≥*
RR`JFV&"aαZεe∩⊗Q1∧
:⊃α≥*NB⊗t!α~Vt~R&>u_4(4U
V&QPJ6>Z,Iα⊃2
V&PHIn2N,∩I↓!α↓9↓EHh(&ε|R1αQe→F↑: b>N∀hP&N.Mα∃αPhP%αR%R¬α¬dλ$%ntyαεJ:↓uyα-~∃α:L`4(%ααB>A¬↓2∧4TJQ∃LRJNQ¬22JQ_h*&~rα&RMeX4(&≤
&9α
bRJV$@$%n"α6⊗εu→α.&daαεM¬
V&⊗$beαε~αB>N≤J
2∀hP%α*∃~QαZe∩QL4PJ6>Z,Iα⊃1 1AAAH%nZ r&22
j~2ε4zJ⊗⊃∧Z&20hP&∞εLqα¬2
"⊗JJ⎇⊂$%n-∩J>I∧j⊗ε:~α↑∃α≤B>V2"α.&2bα&:B-!α
V42⊗H4PIαRJRα⊃1Eβ↓AA@hP&6>4*%αR"a"¬$hP&2NBαRQ1m~⊗≡2|84(εlzZ¬α%!2NQE"Q$4PJR2:*αRQ25@4(¬∧j>Z∃∧!1"¬HH%n~MB:V5∧
J≥↓iqαVN*α~>Iαr
J⊗ Y↓EYbαεJ≤hP&*J≥!αZ2∃!N∧∀Uh%n⊗t!α>→∧J~9αM"L4(hP4*Z bJ⊗QPJ*V6∧)αQ24bJQdHIf2N,∩I↓!α↓9↓EHh(&*≥↓αRQdb↑*ε≤X4(∀∧α∧d⊗ε∩be~h∀e∀XAPPM zα¬αH⊃PPM
Z4DR
¬E4 J:E⊂h&⊗α(M8ZD|J
8∃=≥↓Q M¬Z9∧R¬¬J$-∃P3↓⊃.qP)JQ5
:∀R3Ht∪s@λk∀λ∩)d⊂4∀
)t∀R(~⊃(∪(→SQ4AQL, !~q5⊗IT∀p5j:β"B* t∩H
¬β"C!!"Nng∀∃⊂2hT∀r3()sλ∪j$⊃R6 j3(∩)d⊂+λ
4rλ
P31$
u∀R)hh∪tD
P3∃(T⊃sU T⊃V∀¬a"Nng4∪sH
Itλ∪hd∃∩⊂*Eλ⊂4d ⊂4u∧λV∀λ
9∪u ∧
∃4r∧ tR1i→P3λ
h3∃1$ qH⊃K
C"AQUP3
:∀NB)*tλ∃¬I⊂5∪iQ".tjJR3Qdλ(∀v)XSs∂aQB(∩J*uλ∃H→∀l#!)5 α*85⊗S$
P3⊃I≠α".hi⊂1h
I⊂5λ
h3∀Q*D tu
)3Qid 4h∪Izλ⊂(λi6∪U)Q"B4
Zr∩H
¬∀∪QhZβ"B)YuQ(
%⊃V∀↓QUS∀JFNB2 JVH⊂EE⊂*#!!4∃4i∧⊃V∀¬E⊂J#!!2∀TK$⊂+
λ∃#"B)*34∪Dλ+∃S
* C"A~∃4r d⊃V∀¬F"".j
4rλλ∀⊗Q4It∃stHD⊃StDλqsq∧ 104jZQ#"A~∃4r∧λV∀
!,
VALS1:
IFN ITS,[
SKOTT A,FX ;ALLOW A FIXNUM
JRST VALERR ;ERROR -- WTA
SETOM VALFIX ;REALLY A FIXNUM
MOVE R,FXP ;SAVE A COPY OF FXP
PUSH FXP,(A) ;PUSH THE FIXNUM
PUSH FXP,R ;THEN PUSH THE OLD FXP
POPJ P,
] ;END IFN ITS
VALERR:
IT$ WTA [- ARG TO BE VALRET'ED MUST BE A FIXNUM OR A SYMBOL!]
IT% WTA [- ARG TO BE VALRET'ED MUST BE A SYMBOL!]
JRST VALSTR
;;; ASSUME VALSDR HAS PUSHED A VALRET STRING ONTO FXP.
;;; VALRET THAT STRING IN THE APPROPRIATE MACHINE-DEPENDENT WAY,
;;; EXCEPT THAT CERTAIN "ITS" STRINGS ARE INTERPRETED IN ANY
;;; IMPLEMENTATION (AN ANACHRONISM FOR COMPATIBILITY ONLY).
;;; AFTER DOING WHATEVER, THE STRING IS FLUSHED FROM FXP.
¬
REPVAL8
IFN ITS,[
SKIPN VALFIX ;WAS VALRET STRILG REALLY A FIXNUM?
JRST RETSTR ;NO, NORMAL HANDLING
HRRZ TT,-1(FXP) ;YES, PICK UP THE FIXNUM
.BREAK 16,(TT)
MOVE FXP,(FXP) ;RESET FXP
POPJ P, ;IF CONTINUING RETURN AND GO ON
RETSTR: ] ;END IFN ITS
MOVE R,(FXP)
MOVE D,1(R)
CAME D,[ASCII \:KILL\]
CAMN D,[ASCII \:kill\]
CAIA
JRST VLRT1
MOVE D,2(R)
CAME D,[ASCII \ \]
CAMN D,[ASCII \
\]
JRST VLRT3
JRST VLRT5
VLRT1: CAMN D,[ASCII \≠_.\]
JRST VLRT3
CAME D,[ASCII \≠≠U\]
CAMN D,[ASCII \≠≠u\]
JRST VLRT9
;HERE IS THE MACHINE-DEPENDENT THING TO DO TO RET THE VAL STRING
VLRT5:
IT$ .VALUE 1(R)
IFN @10,[
SA% OUTSTR 1(R)
IFN SAIL,[
SETZ D, ;D IS ZERO FOR TWM DIFFERENT REASONS!
↓MOVEI TT,1(R) ;THIS PIECE OF CRAP LOOKS LIKE
HRLI TT,440700 ; SOMETHING RPG WOULD WRITE (BUT GLS DID)
ILDB T,TT
JUMPN T,.-1
MOVEI T ↑M ;CRUFTY STRAY ↑M MAKES PTLOAD HAPPIER
DPB T,TT
IDPB D,TT ;THEN TERMINATE WITH A NULL
HRLI R,440700
HRRI R,1(R)
PTLOAD D ;LOAD THE STRING INTO THE LINE EDITOR
] ;END OF IFN SAIL
] ;END OF IFN D10
IFN D20,[
PUSH P,A
HRRI 1,1(R)
TLO 1,440700
SKIPE TENEXP
JRST [ MOVE T,1
MOVEI 1,.PRIIN
CFIBF
ILDB 2,T
JUMPE 2,VLRT6X
STI
JRST .-3 ]
RSCAN ;stuff some chars into the RSCAN buff
JFCL
MOVEI 1,.RSINI ;move buff ptr back to origin
RSCAN
JFCL
VLRT6X: HALTF
POP P,A
] ;END OF IFN D20
MOVE FXP,(FXP)
POPJ P,
VLRT3:
IFE ITS,[
VLRT9:
10$ EXIT 1,
20$ HALTF
POPJ P,
] ;END IFE ITS
IFN ITS,[
MOVEI D,120000 ;"SILENT KILL"
VLRT3A: .LOGOUT 1, ;TRY TO LOG OUT
JSP T,SIDDTP
.VALUE
.BREAK 16,(D)
VLRT9: .LOGOUT 1, ;TRY TO LOG OUT
.VALUE [ASCIZ \:VK \] ;OH, WELL...
POPJ P, ;IN CASE LOSER DOES $P FROM IT
SIDDTP: .SUSET [.ROPTION,,TT]
TLNN TT,OPTBRK ;SKIP IF JOB INFERIOR TO DDT
JRST (T) ; (ACTUALLY, IF SUPERIOR HANDLES .BREAK)
JRST 1(T)
] ;END OF IFN ITS
SUSPEND: ;LSUBR (0 . 2)
JSP TT,LWNACK
LA012,,QSUSPEND
IT$ SETZM PURDEV ;ASSUME NO DUMPING
PUSH FLP,R70 ;ASSUME WE ARE RETURNING FROM A RESTART
PUSH FLP,R70 ;ALSO ASSUME FIRST ARG IS NON-NIL
JUMPE T,SUSP0
AOJE T,SUSP0C ;JUMP IF ONE ARG
POP P,A ;2ND ARG, IF ANY, IS SAVE FILE NAME FOR HISEG
; FOR ITS, IS NAME OF PDUMP FILE
IFN HISEGMENT,[
SKIPN SUSFLS
JRST SUSP0C
PUSHJ P,FIL6BT ;CONVERT FILESPEC IN A TO SIXBIT ON FXP
PUSHJ P,DMRGF ;MERGE WITH DEFAULTS
POP FXP,SGAEXT ;UNSTACK ARGS INTO PROPER SPOT
POP FXP,SGANAM
POP FXP,SGAPPN
POP FXP,SGADEV
PUSHJ P,SAVHGH ;SAVE HIGH SEGMENT
FAC [FAILED TO SAVE HIGH SEGMENT - SUSPEND!]
] ;END OF IFN HISEGMENT
IFN ITS,[
PUSHJ P,FIL6BT ;CONVERT FILESPEC IN A TO SIXBIT ON FXP
PUSHJ P,DMRGF ;MERGE WITH DEFAULTS
POP FXP,PURFN2 ;UNSTACK ARGS INTO PROPER SPOT
POP FXP,PURFN1
POP FXP,PURSNM
POP FXP,PURDEV
] ;END IFN ITS
SUSP0C: POP P,A ;POP FIRST ARGUMENT
SKIPN A ;FIRST ARG NIL?
AOSA (FLP) ;YES, NO VALRET STRING
PUSHJ P,VALSTR ;NO, PROCESS IT ONTO FXP
SKIPA
SUSP0: PUSH FXP,R70 ;ZERO WORD MEANS VALRET STRING
SETZ A,
MOVEI T,LCHNTB
SUSP11: SOJE T,SUSP12
SKIPE B,CHNTB(T)
CAMN B,V%TYI
JRST SUSP11
CAMN B,V%TYO
JRST SUSP11
MOVE TT,TTSAR(B) ;IF FILE IS CLOSED THEN IGNORE IT
TLNN TT,TTS.CL
PUSHJ P,XCONS
JRST SUSP1⊃
SUSP12: JUMPN A,SUSPE
HRRZ A,V%TYI ;CLOSE THE TTYS LAST, SO THEY WONT CAUSE
MOVE TT,TTSAR(A) ;SPURIKUS "CANT SUCPEND -I/G IN PROGRESS"
TLNN TT,TTS.CL
PUSHJ P,$CLOSE
HRRZ A,V%TYO
MOVE TT,TTSAR(A)
TLNN TT,TTS.CL
PUCHJ P,$CLOSE
SUSP12 HRROS NOQUIT
MOVEM LIL,GCJASV+1
MKVE T,[FREEAC,,GCNASV+2]
↓BLT T,GCJASV+2+17-FREEAC
SETOM NOPFLS
IFN ITS*USELESS,[
MORE T,IMASK
TRNN T,%PIMAR
JRST SUCP14
,¬'+'∃(A6]I≠β%α0Y'β-5β%:~(∩]'+M A69'∪β%∧XY$nA:~∃'U' bhh~∃*∩$s ≥λ↓∨ A∪→≤A∪)LU+' 1 '&~(_~∧~)∪
≤A%)'9λH`Y6~)∪ H∪M )∂~↓'β/'@∩∩w∪Q&Aβ→]β3&A]β≥)&↓)≡A <AαA!5β A
I∨⊂∃α4J2∀Q!∀l]hY∩¬"HiE≥≥H~%%-↓Q L-λ9α¬"II∃≥¬:qPPLYzd,jλED<≤h~50H&&α Lλ*%B¬EHTu%hX0HK88U"¬IλRα∀9ye$LjXR∩∧_HE∀-:4¬$z
:D
∃EZUh&&α L
*$j¬EHTu%hX2[λQ!∃≤\~λR¬≥X8de_⊃↔4L2λiE-≤ →d:¬λZ$*¬λ_t-~
$l≤Z:2¬4→J$-"
I∧,pQ!∩∧U*:B∧4J9E≥Q(de≤izCPLYzd,J
AE≥-:ε0HK8j$|J λU∀
yb∧Ld
5$
*D∧
"
:U≥β4λDM∀X:DeHQ!∀l]hYR¬"II∃≥¬:qPPM
Z4DR
¬E∧¬YZ∧`H↔:¬-∀TλE,m∧ DM≥∧ ∀2∧~
¬∀⎇
)∀
$QQ M≤9~∧*αλiEαH⊃↔4tLD $≤CqQ J∧**5"¬:Z4≤|a⊃∪MLZ5B∧≤yjDLUXT∧|Rλ→d"¬(ZE-∀d
@hP~94M∧dε∩bDk
αHH↔;$-∀t
t⎇∀D T, j4∧tz
h∀e∀X@¬≥%)→d8h!∀∧U∃:@¬≥-:ε# h)~B M
Z4DRλ¬E∀-Jh∀`h&&α Lλ*$|Jε⊃C
C∃⊃P@L**5"¬:Z5β∪QQ%hKαq3HD∪qH _SH∩*Jw⊃∧F↓ C"I_SH⊃ε⊗ ⊗c!!2∀TK⊂*⊗↔∩!)`QβE HRL T,.JBREN"λ
∀∪5∨% ~↓(Y∂π9β',~(∪≠∨-∀A(X])↓% _$∩w∂ PA⊃β∂! '(A¬ $A/∀A≥ ⊂A)∞AMβ-
~(∪⊃%→4A(X])↓'α∩$sβ≥λ↓')∨%∀A∪≤A
∨%%
(A!→¬π &AM≡A ∨9∪)∨$↓↔≥∨/L~∀β≠=) ~APX]∃¬→ ~∀∪5∨- ∩↓(Y'+M f~∃!&J∪⊃I%~A(0]∃¬'∧~∃⊃&⊂∪⊃%%4A(Y%∃)⊃∂⊂4∀∪'↔%!α@Q→→ R∩$s≥∪_↓∃π_}4∀∩A∃I'(A'U'π∨≤$∩w3 LXAπ∨9)∪≥+∀Aβ≥λ↓% )+I≤A(~(∪'↔∪A≤@Q
a R~∀$A∃%'PA'+'@dh~∃MαH∪!U'⊃∀A@Y% Yβ_∩∩m!)→∨¬λA-β1% (AM)%∪≥≤A
∨$↓'β∪_4∃'αH%' )54A- ∃=¬≥+~4∀∪∃%M(A'+M dj~):∩∩w∃→A∨_A∪
≤↓λb`~(~∃'+M dht↓≠↔-
↓(Y
1@~∀∪!=!∩Aλ0b~∀∪5∨% ~↓(XQ
a R
∀D`H∪≠T,
20$ HRROI 1,FLSPA1
IT$ MOVEI TT,FLSPA1
SUSP25:
IFN ITS,[
.VALUE (TT) ;PRINT SUCPENSION MESSAGE
↓JRST SUSCON
] ;END OF IFN ITS
IFN D20,[
PSOUT
HALTF
U ;EJD OF IFN D20
IFN D10,[
↓OUTSTR (TT)
HS$ JRST KIL@GH
IFE HISEGMENT,[
IFN SAIL →64∀∩∪≠=) ∩A∧Y
β↔⊃ (∩∩m
∨≡X↓⊃∨.A5β≥2A]β3&A
β≤A'¬∪_A→='
}~(∩∪'↔%!≤@])¬ ($∩vA∃=¬ (↓≠+'(↓¬
A≥=≤[5 I≡A)≡↓'β-
∧~∀∩∩↓' ) ⊃(AαX$∩vA 1'
A≠¬2A
β%_A)≡↓'β-
↓ ≥)∪I
A→∨M ∞~∀%:∩@@@w ≥⊂A∪
≤↓'β∪_4∀∪ 1%(@bX4∀@@@↓:∩@@@w ≥⊂A∪
↓⊃∪' ≥≠ ≥(4∃:∩w∃≥λA∨_A∪
≤↓λb`~(~∀_∩∃'U¬))_%⊃∪∂⊂↓' ∂≠∃≥(A'¬-αA¬=+)β≥∀~∀
∃%
≤AλD`Y6~(~∀vVlA)⊃
↓% → Yβ≥(A→∪⊃
A9β≠ &↓β%
A%≤A'∂¬ ,X↓'∂β!A≤XA'≥β 1(8~∀vvlA)⊃
↓≠β∪≤↓
∪→
↓→β≠
↓∪&A!¬'' λ↓)⊃%∨U∂⊂A(0Aβ≥λ↓')∨%∃λA∪≥Q≡~∀vlvA'∂¬≥β~A=≤A'+
π '&8@A'↔% A% Q+%≤A=≤A'+
π '&8~∀~∃%
≤A⊃%' ∂≠∃≥(Y64∃'β-!∂⊂t∪1∨π↔∩$∩∩w→=π⊗A∨U(A∪≥Q %%+A)&AβI∨+≥λ↓+'
A= A) 5 Aπ⊃¬≥≥ _4∀∪≠∨Y
A YM∂β≥β4~∃∪
8A'β∪0Y6~∀%'↔∪!0@]∃¬!%_∩∩m∪&A⊃%' ∞A
+%% 9)→2A]%∪)
5!%∨)∃π) λ|~∀αA)%'(AMβ!/∪8∩∩w≥<XA≠+M(A!%∃)∪∨+M→2A⊃¬-αA+9!+%∪→∪ λA%(~∀∪M↔∪!≤↓!'∂≥¬~~∀∩↓∃%'(↓
β'→U⊂~∀∪5∨- ∩↓(X]∪= ≠ ~(∪≠∨-∀A)(YA'∂ X~∀∪'∃)4Aλ0~∀β∨A ≤A 5!εY($∩w∨!∃≤A+ Y'⊃$↓
∪→
↓ -∪
A∪≤↓ +≠ ↓≠∨
4∀∩A∃I'(A
¬'→+⊂4∀∪≠∨Y
A(YA'∂≥β4~∀∪≠=-
A)PY!'∂∃1(~∀%' )4↓λX~∀%≠∨-
↓$Y!'≥!! ~(∪→∨∨-+ A)5!εY(4∀∩A∃I'(A
¬'→+$4∀∪≠∨Y&A(YH~∀∪≠=-≥&AP∩∩∩wPA∂ )LA→ ≥≥)⊂A∨_@]'⊃HA
∪→∀~∀∪β⊃ ∩A(1⊃'∂∨I∞Zb~(∪!+'!∀A Y1 %∪⊃L∩∩w∂<A% β⊂A∪≤A!∪∂⊂AM ∂≠ 9(@Q
I∨~A/%)⊃∪≤↓→∨' ≤BR~∀%% → ¬'
A)5!εX∩$w
→+M⊂A) 5 Aπ⊃¬≥≥ _4∀∪≠∨Y
A(Y⊂ba≥β4∩∩w+M
AλbA≥β~A¬&A⊃∪M ∞A≥¬≠
A)<A
∨∪0A'⊃βI∪≥∞~(∪→'⊂↓(XZl$∩wβ&↓→∨≥∞↓β&A/∀O%
A ∪≥∞↓%β≥ =~\\\4∀∪' Q≥~dAPX~∀∪)
π_~(∪≠∨-∀A Y'≥β≥β~$w% 'Q∨%
A5β∪≤A→∪→
A9β≠
~)'β!/%≤t@~):∩w 9λA∨ ↓∪
≤AMβ∪_~(∪' )i~A'∂¬≥β~~(∪≠∨-∀A$Y'≥β ,4∃∪
≤↓'β∪_16~∀vlw'β-∀A-β→% β)∪=≤A/∨I &A∪8A⊃∪'∃∞XA⊃=!
A)!β(A⊃%' ∞A]%∪) ¬¬→
~(∪≠∨-∃~A$YA'∂ X~∀∪≠=-
Aλ1'∂β a(~∀∪5∨- ~↓λY!'≥ 1(~(∪≠∨-∀AλY'≥β!!≤4∀∪≠∨Y ~Aλ1!'∂!A≤~∃:$w ≥λ↓∨ A∪→≤A'β%_~∀∪5∨- ∩↓λX]∪= ≠ ~(∪≠∨-∀A(Y $∩w'∂¬≥β~A]β&A'¬- λA%≤A ~(∪' )hA X~(∪∨! 8A)≠! Yλ~∀$A+≥→-!∨!∀4∀∪≠∨Y
A)(1'∂β a(~∀∪M )4A⊂X~∀∪5∨-
AHY'∂βA!≤
∃MαH∪≠=- ~APY!'∂9β~~∀% ≥) HA)≠! Y(~∀$A+≥→-!∨!∀4∀∪≠∨Y ∩A)PY⊃'∂=%∞Zb$w≠β↔∀A+ A%∨/λ~(∪'+∧↓)(X])¬⊃%_4∀∪≠∨Y'&A)P~∀∪⊃I%∩A)PY⊃'∂=%∞Zb4∀∪' Q4AλX4∀∪∨+PA)≠! Y)(∩$w∨+)A+(A)!
A⊃∪M ∞~∀$Aπβ∪∧~∀∩@↓+≥→↔A∨!∀~(∪π→∨M
A)≠AεX∩∩m
→+' A) ≠@Aπ⊃β9≥ _~(∪% →∃β'
AQ≠!εX4∀∪≠∨Y ~A(1'∂β≥¬~∩∩w]
AπβI
+→12A ≡↓≥∨(AM)∨%
↓'∂β≥¬~A+≥Q∪_~∀%+≥→∨
↔∩∩∩$vA/
↓⊃β-
↓π→ βI→2A/=≤@Q≠=%
A∨HA→ 'LR~∀∪)%'(AA∨!∀b4∀~∃:$w ≥λ↓∪
≤A!∪' ∂5 ≥(~):∩∩w∃≥λA∨_A∪
≤↓λb`~(~∀_~∃'U¬))_%β%∂&↓
+≥πQ∪∨≤~(~∃β%≥&t∪∃M A)(1→/≥β
⊗∩∩w1'+¬$Pb@\dR@Z↓+' &↓αY∧Y Y(Y)PYλY$1 ~∀∪1αbdX1#β%∂L~∀∪∃M A$YA →αd!(R∩∩m'!% ¬λAβ%≥&~∃βI∂&bt%'↔∨)PAαY'd~∀∪∃I'(AβI∂&`∩$w
∪%M(Aβ%≤A≠+'PA¬
AM3≠¬∨0~∀∪⊃1%4A 0QαR~)β%∂&Eαt∪β=∃_A(1β%∂&L∩∩w)]≡Aβ%≥&~∀∪!→%4AHXbQ $∩∩w∃U'(A/¬≥(A)<A∂ (↓!% '∃≥(AβI∂&A!I∨ ~∃¬%∂'πTt∪∃+5!
A$1
β→'∀∩∩wβI∂&Aπ=≥&[+@~∀∪∪⊃∪-∩AHXb``@~∀∪'-∪!≤AλY ~∀%∃%'(↓β%∂' b~∀∪5∨- ∩↓)(XZDQ R~(∪∃' ↓(Y
∪`cα~∀%≠∨- $A∧XQ∧R~∃βI∂'εbh∪'↔∪A≤AαYH~∀∪∃I'(Aπ=≥&~∀%≠∨- $A)(X!$R~∀%πβ∪
↓)(Xn\n~∀∪M+¬∩AQ(Xb~(∪∃' ↓(Y
∪`cα~∀%∃%'(↓π∨≥&4∀~∃βI∂&ft%∃+≠!∀AαYπA∨!∀~(∪∃+≠A≤A∧Y¬%∂&j4∀∪⊃→I4A$XDQ R∩$w∃+'PA/β≥PA)≡A→→+'⊂↓β%∂&↓!%∨ 4∀∪∃+5!
A$1
β→'∀~∀∪'∃)4A$0~∀∪!U'⊂A 1α~∀∪)' Aλ1β%∂π1∧~∀∪M+∧A 1$n`VD~∀∪∃I'(A)I+
~∀4∃β%∂Ljt∪!U'⊂A 1α~∀∪M )5∧↓)(Y$4∀∪⊃→I4AεX!∧R∩∩m≠+≠¬1
A≠+5¬→
@4A≠+'PA
∪∂U%
~∀%∃+≠!∀AεYβI∂&l∩$vA∨+PA/⊃βQ - $↓/
A/∃%
A⊃¬≥ λ4∀∪∃'@A(Y
a≥,f~(∪πβ∪∀A$Xn\n~∀∪¬ ∩AHXb~∀%→'⊂AHXbb~)β%∂&Xt∪⊃%I4AαX!∧R~∀%∃' APY
1≥Xb~∀∪
β∪
AQ(Xnn\~∀∪β⊃ ∩A)PXb~∀%β ∩↓$XQ)PR~∀∪!→%4AQ(XbQ_R∩∩w1∨∨⊗A¬(Aβ%≥&A!%= Aβ→I β 2↓)⊃ %∀~∀∪π¬∪≤A)PXQ$R$∩w∪ ↓β→% ¬ 2A/!β(A/∀A/β≥PXA∃+M(A 1%(X~∀%∃%'(↓!∨!β(∩∩vAQ⊃ % 2Aβ-=∪ ∪≥≤AαA!U%
A!¶
A)Iβ ~∀%≠∨- $AλY!=!β∀∩$w
β↔∀A∨+(↓αA∃'@AλX~)β%∂π1∧t∪≠=- ∩AλXQ R$∩wπ→=¬¬ $↓∪≤Aβ8Aβ%∂LA!%∨A %)24∃β%∂
_ft~)!+%)Iβ AβI∂π_n1∧X∪⊃I→~A$0bQ∧R$∩w≠βdA⊃β-∀A)≡A→+'&A¬¬∨+(↓!+%
↓!β∂
↓)%β 4∀∪∃%M(@Qλ$~∀
∃¬%∂&`h∪≠∨-∃∩A X⊂HI≥∪0~∀β∃U≠!
A∧Yβ%∂Lcα
∀%/)αAlA≥∨≤5'3≠¬=_@ZA¬%∂&Ct~∀∪∃I'(AβI∂&b~(_~∃'U¬))_% %β→→%β≠
↓
+≥πQ∪∨ X↓∂)! 1 XAβ9λA
%∃)+%≤4∀~∃ Yβ→
%­
t~(∪'↔∪AαA$Ym∂)! 1!:∩wQ⊃∪&A∃≥)%2↓ββ+'∃&A∪≥Q %!%∃)β)∪=≤A∨ ↓β%∞A¬&A! 1!∨∪≥Q $~∃→%~eαh∪≠∨-∃∩A$Y≥)! _H∩w)⊃%&A ≥Q%2XAQ~Aβ→1∨&Aπ=≥)∪≥U∪∃∞A→%∨~A]⊃β%
↓λAπ+I% ≥)12A∪&4∀∪∃'@A$XQHR~∀∩@@I Yβ→
%­
∩w≥ (A Yβ→
%­
A∨HAβ!!13
%β5
A∃+M(A!%%≠$A)<~∀α@@Iβ!A→3
%­
∩v↓!∨∪≥PA∨≤AA _A≠¬%↔ λ↓↓2AβI∞~∀∪)%'(A→β→'
4∃
%~Lt∪'+λAλY$\`Vb∩m β
∪9
AαA→%β≠
↓!∨∪≥Q $A <A¬
A)+'(A →∂.↓)⊃
A∃-β→
Iβ≠
A5β%↔ H~∀∪⊃I%4A)PXQλR4∀∪∃+5!≤A 1
%~g∧∩∩w ↓∪&A∪9 A= A/⊃%π⊂A↔%≥λA∨_A
%β5
~∀∪5∨% ∩↓(XQ)PR~∀∪1'⊂A(0[' ∂1≠∞~∀%'↔∪!0A'(QPR~∀∪)%'(A→%~iα4∀∪⊃→I4A)(0Q)(R4∃
%~Mαt∪π¬∪≤A PY# -¬→
%β5
∩w =≥(Aβ1→∨.AQ⊃
Aπ¬→_A)<A -β1
%β≠∀~∀β∃I'(A
I~e∧∩$vA∪)M → AQ≡A¬
↓∨#)!U(~∃
I~iαt%!+'⊂↓ XQλ$~∃
%4ht∩∩$w %%→%β≠
↓π↔≠ LA⊃ %∀~∀β⊃1%≡A)PXQλR$w↔≥
↓→
(↓⊃β→ ≥&Aβ&↓∂∨∨λ↓β&Aβ9∨!⊃ H\\\~(∪∃' ↓(Y
∪`cα∩w5β↔
AU A!¬∃-∪∨+LA'!
∪β_AA _A!=∪≥) H~∀∪!U'⊃∀A@Yβπ∨9&~∀∪∃1π⊂AλXQ R4∀∪≠∨Y
A)(0bQλR4∀∪πβ5
A)(16Iβ!A→3
%¬≠ :~(∪∃%'PA
%~`~∀∪!U'⊂A 1α~∀∪A+'⊂A@Y∧~∀%≠∨-
↓(XZd!λR@@9'
@⊃β!!→e
%β≠∀@∩w¬∃πβ+'∀A)⊃ I
A∪&↓αA ∪Mπ+''%∨∀~∀%∃+≠!0A(Y
I~j∩∩$p
↓α|1αR"*α~Jεl)α~>∀jεQα$B⊗J∀hP&6>4*%α¬bBQ$4PJR2∞rαQ15λH$%n$B&:-∧
>V"αR"&~α↑"⊗rαf>U∧b>>-λh(&*∃~Qα~∀i\4(LB2JM¬ $$$KZNV
$b∃α↑
IαR=∧:⊗Qαt*≡εRLz84(L
∩∩%¬!1"⊃Hh*~Jk)h&N-"iα¬`h*~Jk*¬h&E∩Jiα∩a"Q$hP&BV≤B)αAeB∞.:_h(&ε|∩*9α b~J5,λ4(&¬*N")¬↓2:J-2⊗JN(h*~Jk9h&B-~")ααbε∞>u_4(&∧zAαAd⊂4(&¬*N")¬↓2b∞|rL4(Lj>Z⊗Jα 1"
H4(&∧zAαAdλ4*~∀iah&¬*N")¬↓2b∞|rL4(Lj>Z∃∧⊃2∧%\zVRB-!↓Q6dJNQiα↓↓
⊗4
1 α⎇⊃↓
ε¬α2e ∧zI↓
-∩I α\ αNfl∩>2thP&"J∀z%αR"a"⊃$KY↓α~∀
6∃↓E∩⊗≡B$a%αB|J:R⊗∩αf¬α4Jb:Vmh4(εU~AαQd2&aFλIm↓↓d2>J5rαn⊗Z buα>∩↓!b~sq↓rε∀:My%¬ZεBBeJt4(MαVN"RαA2∞|rL%lLzI↓rm~≥6~⎇∩5yα\*JJthP&6>4)αRQc "↓$KY↓αεdJNQ↓E~Bε∞∧"1%α∧z&:R-⊃αn¬∧2&b:,jt4(Lj>J⊗Jα 2F|*Zε0hP&∞εlqαRQeY∩εB∧bf~J j⊗t4PJ6>Z,Iα 2
BB2Hh(&∞ j9αR"be∩⊗∃∩~Jεl*t4(Lj>J⊗Jα 2F-∩H4(MαVN"RαA2b≤z:L4PJ*JN αB>B∀P4(∀T2J5J∪P&R2t)αI1λh(&ε$!α↓2∪9A-HKZ↑"⊗pαN⊗εHING FORWARD, SKIP OVER CALL
JRST FRM2A ;TO EVALFRAME
GTPDLP: ;CALLED BY JSP R,GTPDLP; RETURNS PDL PTR IN D
MOVEI D,(P)
JUMPE A,GTPDL2 ;ARG=NIL => START SEARCH FROM CURRENT PDL POS
JSP T,FXNV1 ;NOTE: EVALFRAME LOOKS AT BIT 3.1 OF R
JUMPL TT,GTPDL5 ;BIT 3.1 OF R = 0 WHEN SEARCHING BACK THE PDL
TLO R,1 ;BIT 3.1 OF R = 1 WHEN SEARCHING FORWARD
MOVNS TT ;WANT TO SKIP OVER THE FRAME MARKER WHEN
SKIPN TT ; SEARCHING FORWARD (SINCE A PDLPOINTER WILL
SKIPA TT,C2 ; BE POINTING TO ONE BELOW A FRAME MARKER)
ADD TT,R70+2
GTPDL5: TLZ TT,-1
HRRZ T,C2
CAIGE TT,(T)
JRST GTPDL1
MOVEI T,(P)
SUBI T,(TT)
JUMPLE T,GTPDL1
MOVEI T,(TT)
CAIL T,(P)
MOVE TT,P
HRROI D,(TT)
GTPDL2: MOVE TT,(R) ;KEY ON WHICH TO SEARCH
JUMPE TT,2(R) ;MATCH 0 => NO SEARCH, JUST GIVE OUT PDL PTR
MOVE F,1(R) ;WELL, IT'S POSSIBLE TO SEARCH FOR TWO THINGS
TLNE R,1
JRST GTPDL4
HRRZ T,C2
GTPDL3: CAIL T,(D) ;A BACK SEARCH
JRST 2(R) ;SEARCHED-AND-FAILED EXIT
CAMN TT,(D)
JRST GTPX0
CAMN F,(D)
JRST GTPX1
SOJA D,GTPDL3
GTPDL4: MOVEI T,(P)
GTP4A: CAMN TT,(D)
JRST GTPX0
CAMN F,(D)
JRST GTPX1
CAIG T,(D)
JRST 2(R) ;FAILURE
AOJA D,GTP4A
GTPX0: TDZA F,F
GTPX1: MOVEI F,1
JRST 3(R)
FRETURN: TDZA C,C ;LH OF C REMEMBERS WHICH ENTRY
FRETRY: MOVSI C,TRUTH
HRR C,B
JSP R,GTPDLP
0
JFCL
MOVEI F,(D)
MOVE TT,[$EVALFRAME]
CAMN TT,1(F)
JRST FRETR1
MOVE TT,[$APPLYFRAME]
CAME TT,1(F)
JRST FRERR
FRETR1: MOVEI D,(F)
SUBI D,(P)
HRLI D,(D)
HRRI D,(F)
MOVE TT,[$UIFRAME]
CAME TT,(D) ;SEARCH FOR A USER INTERRUPT FRAME
AOBJN D,.-1
CAMN TT,(D)
JSP TT,UIBRK
FRP1: SKIPE T,PA4 ;BREAK UP A DOMINEERING PROG
CAIL F,(T) ;[WHICH BREAKS UP INTERIOR ERRSETS AND CATCHES]
JRST FRP2
MOVEI TT,FRP1-1 ;FAKE OUT RETURN BY INSERTING A RETURN-ADDRESS
MOVEM TT,-LPRP+1(T) ;OF FRP1 ON THE PDL
JRST RETURN
FRP2: SKIPE B,ERRTN ;BREAK UP A DOMINEERING ERRSET
FRP2A: CAIL F,(B)
JRST FRP4
MOVEI T,FRP1
MOVEI TT,FRP1
JRST BKRST0
FRP4: SKIPE B,AATRTN ;BREAK UP A CATCH
CAIL F,(B)
JRST FRP3
MOVEI T,FRP1 ;IN CASE OF UNWIND-PROTECT
MOVEI TT,FRP1
JRST BKRRπP`~∀~)
% fh∪'↔∪A≤A∧Y∃∨
%)8∩w¬%∃β⊗A∨U(A∨ ↓β≥2A∀[≡[ ↓' (AI β &4∀∩A∃I'(A
I g#α4∀∪πβ%∂
A 0Q∧R~(∩A∃%M(A
%@eα~∃→% g#∧t∪≠∨Y ∩Aα0QεR~)∪
AAβ∂∪≥≤Y6~∀%β ∩↓ Xb∩$w
∪0↓+ A!⊃_A!∨%≥) %L~∀∪'U∧A Y d~∀∪!%→&A_~∀∪β⊃λA Y d~∀∪5∨-
A@Y ~∀%⊃%%4↓ XZd! R~∀%'+∧A_Y
1εH~∀∪⊃I→&A 4∀∪β ⊂A Y
aεd~∀%≠∨-
↓
1 Y_~∀∪⊃1%4A 0ZdQ $~∀∪'U∧A Y→→εd~(∪⊃%→LA ~∀%β λA_Y
→εH~∀∪≠=-
A
1 Y ~):∩∩w∃≥λA∨_A∪
↓!β∂∪9∞~∃∪→≤A!β≥∪≥∞Yl∩∩∩w%≤AαAAβ∂ λ↓'3')∃~XA)!
A! 1∨,A⊃¬≥ → H~∀∪⊃I%∨∩A@XbQ $∩∩vA]∪→_A→∪0A+@A)⊃
↓→⊃&A= A)⊃∀A! _↓!)%&4∀∪⊃→I≡A
→@XZdQ@R~∀∪!%%≡A→1 XZHQ R~)∪
≤AA →¬+≤Y6~∀%!
∪1A _A)P~∀∪
1!
∪1A _A)P~∀∪
a!
∪1A _A)P~∃:∩m ≥λA= A∪
8A! → +∞~∃t∩∩w 9λA∨ ↓∪
≤AAβ∂∪≥≤~∀∪⊃1%4A)PXZbQ@R~∀∪Q→≥≤A XZb∩$w
∨$E
% Q+%≤D↓∃+'(↓+≥¬∪9λA)≡↓≠β%↔∃λ~∀∩↓∃%'(↓+¬λ∩$v@A!=∪≥(X↓β≥λAA∨ A
Iβ≠
~(∪!+'!∀A YU¬λ~∀%⊃→%4↓)(XQ∧R∩∩w +(A <A≠∨%∀A
∨$E
% Q%2DX↓β
) HA+¬λ4∀∪∃'@A(XK
β $4∀∪!∨A∩A Y0I -β1
%β≠∀∩w∂ PA%∪λ↓∨ A¬¬'∪εA∃-β→
Iβ≠
~(∪πβ∪∀A)(YEβ!!→d~∀∩@↓∃%'(↓ -β_4∀∪⊃%I4A∧X!αR~∀%⊃→%4↓∧XQ∧$~∀∪⊃1%4Aα0QαR~(∪⊃→%∀A(XQ@R∩∩w≥ (A%%λA∨ ↓β%∂&↓∨≤AβA!→3
Iβ≠
@4∀∪'↔%!∞A($∩∩w
%∂+%
↓∨+(A1 ≥∂) A∨ A¬%∂&AAβ%(~(∪≠∨-∃∩A(XD~∀∪⊃I→∩A(0Q(R~(∪'+∧↓ Y(~(∪∃%'P@]β!A→2~∀_~∃'U¬))_%∂ )π!β$XA≥ )π⊃¬%≤XA¬≥λA∪9) %≥¬_A')I∪≥∞A→+≥π)%∨≥&~(~∀I∂∃)π⊃βI≤t∪!U'⊂A 1π
∪0D∩∩w'U¬$@dZA≥π¬→→β¬1
~∀∪M↔∪!α↓ Y75A∨!∀X1π!∨!):~∃∂∃)π⊃βHt∪≠∨Y
A Ym
β→'∀XY%
⊂e:∩m'+¬$d~∀∪M↔∪!
↓,]%'∃(~∀∩↓∃%'(↓∂ )π p~∀∪M↔∪!∞↓λXQ∧$~∀∩A)%'(A≥ )π⊂P~∀∪!U'⊃∀A@Y!≥∂P`~∃∂∃)π⊂bh∪'∨∃0AλXQ_R~∀∪% ∪-∩↓λY¬3Q'/λ∩lQ"Y$$A#+∨Q∪ ≥(1% ≠β%≥ $↓∪≤Aλ1$~∀∪M∨∃_A⊂Y∂ )
⊂f~∃≥ )π⊂Ht∪⊃%I4AαX!αR∩w
$A¬dA"A/=% &~(∪'∨∃≥
AλY≥ )π⊂H∩w%
β→_AQ⊃β(@!π $A9∪_R@tA≥∪_4∀∪∃+5!
Aα1∂ )π h~∃∂∃)π⊂fh∪⊃→%hA)(X!αR~∀%→ ∧AQ(Y¬!¬%&Q$$~∀∪∃U≠!≤AQ(XQ $~∃∂ Qπ⊂ht%≠∨-&↓ Y ~(∪∃%'P@Q R4∀~∃∂∃)π⊂ph∪∃' ↓(Y
19,d~∀%!+'⊃(A Y!9∂ (~(∪∃+≠A∞AλY≥ )π⊂D~∀β∃I'(A∂∃)π⊂h4∀~∀wQCEYJ↓←LAEeiJ[aQefXA%]i↑@ CeeCdDAEr↓S]ISIKGiS9NAiQIjAgCHA←LAM)$↑u¬%%β2~∃¬!¬$t∪%∃! β(jXApxfjZ\T]%!
≥(⎇>Ll|V`]>f`AQ)'β$-')$K¬$~∀wQCEYJ↓←LAEeiJ[aQefAM=dACEM←Yki∀ACIIIKgfX↓S]IK`OHAEdA)(~)¬!β%Lt∪% A β(@TX@xxLjZnT9%!π≥P⎇>flxV`o>L`@Q)PR~∀~(~∀K∪Mε]≤t%!+'⊂↓ Yπ
%0b∩∩$vW∪≥Q %≥β0[π⊃βH[≤~∀@A¬β-!%≡~(∪≠∨-∀AλXQλR∩∩∩m∪∃ `A∨ A⊃ '∪∂9β) λ↓π⊂~∀%∪ ∪-$AλXj4∀∪')I/ ≥≡↓)(Yα$∩∩w∂=%λ[∪9 0[%≤[β%Iβ2A∨_A')%%≥∞A¬¬'
~∀$Aβ $A$Y¬Aβ%&[ !β$@$∩w+'∀A∨)⊃∃$A¬ ↓)β¬→∀A∪ AA+%
AM)%∪≥≤~∀∪β⊃ ∩A)PXQλR$∩∩w∂=%λ[∪9 [%≤[')I∪∃∞A= A% E+ ')∃λAπ⊃¬$~∀∪1 ∧A)PY¬!βHQ$R∩$∩w∪≠A+%
AM)%∪≥≥&A⊃βY
A/∨Iλ[∪≥⊃ 0A∪9)≡~∀@@A≥=!%≡~(∪!∨!(A X∩$∩∩vAM)$↑uM)%∪≥≤[β%%¬2~∀~(K∪'$9≤t∪≠=-αA 0QεR∩$∩vW∪9) %≥¬_[%!1βπ⊃βH[≤~∀@A¬β-!%≡~(∪≠∨-∀AλXQλR∩∩∩m∪≥ `A∨ A⊃ '∪∂9β) λ↓π⊂~∀%∪ ∪-$AλXj4∀∪')I/ ≥≡↓)(Yα$∩∩w∂=%λ[∪9 0[%≤[β%Iβ2A∨_A')%%≥∞A¬¬'
~∀$Aβ $A$Y¬Aβ%&[ !β$@$∩w+'∀A∨)⊃∃$A¬ ↓)β¬→∀A∪ AA+%
AM)%∪≥≤~∀∪β⊃ ∩A)PXQλR$∩∩w/=%λ[∪9 0[%≤[')I∪≥∞A= A M∪∂≥βQ λAπ ~∀∪ A∧A Y !β$QHR~∀@@A≥∨A%≡~∀%!∨!∀↓ X~∀4∀K∪'\]≤t∪A+'⊂A@Yπ
∪`b∩∩∩lW∪≥)∃%≥β_5')%∪9∞[/∨Iλ[≤~(@@A¬¬↔!%≡4∀∪')I/ ≥≡↓)(Yα$∩∩w/=%λ[∪9 0[%≤[β%Iβ2A∨_A')%%≥∞A¬¬'
~∀$A∃%'P@\Vh4∀∩@A¬ λA)PXQ∧R$∩∩w/=%λ[∪9 0[%≤[')I∪≥∞A= A% E+ ')∃λA/∨Iλ~∀∩A≠∨-∀A)(Y↓))'βHW')$∃β$~∀$@A!∨A∀A X4∀∪β ⊂A)(X!∧R~∀%≠∨-
↓)(XQQ(R~∀@@A≥=!%≡~(∪!∨!(A X∩4∀~∀K%''.]8t∪≠∨Y
A$X!εR∩∩lW∪≥)∃%≥β_5' ([M)%∪≥≤[/∨%⊂[≤~∀@A¬β-!%≡~(∪')%] ≥≡AQ(Yα∩$∩w/∨Iλ[∪≥⊃ 0[∪8[β%%¬2A∨ ↓')%∪9∞A¬βM
~∀∩↓∃%'(\Vh~(∩@Aβ⊃λA)(0Q∧R∩$∩w/∨Iλ[∪≥⊃ 0[∪8[')%%≥∞A∨_A% #U ') ⊂A/∨%⊂~∀∩@↓≠∨- 4A$Y↓Q)'β$-')$K¬$~∀∩A!∨!(A X~(∪β λ↓)(XQλR~∀∪5∨- ~↓$XQ)PR~∀@@A≥∨A%≡~∀%!∨!∀↓ X~∀4∀~∀
SUBTTL SUBLIS
SUBLIS: JUMPN A,SUBLSA ;NULL SUBSTITUTION LIST?
MOVE A,B ;YES, RETURN SECOND ARG
POPJ P,
SUBLSA: PUSH P,A ;USES ONLY A,B,T,TT,D,R
PUSH P,B
MOVE D,A
HLLOS NOQUIT ;MOBY DELAYED QUIT FEATURE
SUBL1: JUMPE D,SUBL2
HLRZ T,(D) ;A SUBSTITUTION LIST IS LIKE
HLRZ B,(T) ;((U1 . S1) (U2 . S2) . . .)
SKOTT B,SY
JRST SUBLOSE
SUBL1B: HRRZ A,(B) ;SEXPRESSION S IS SUBSTITUTED FOR ATOM U
HLRZ A,(A)
CAIN A,QSUBLIS
JRST SUBL1A
HRRZ A,(T)
MOVEM B,T
HRRZ B,(B)
PUSHJ P,CONS
MOVEI B,QSUBLIS ;PUT "SUBLIS" PROPERTY ON THOSE ATOMS U IN THE
PUSHJ P,XCONS ;SUBSTITUTION LIST ((U1 . V1) . . . (UN . VN))
HRRM A,(T)
SUBL1A: HRRZ D,(D)
MOVE T,INTFLG
AOJGE T,SUBL1 ;0=> NO INT, -1=> USER INT, -2,-3=> QUIT
MOVE R,D
JRST SUBL3Q
SUBLOSE: JUMPE B,SUBL3Z
MOVEI A,(B)
MOVEI R,(D)
MOVEI T,[LER3 [SIXBIT \NON-ATOMIC ITEM - SUBLIS!\]]
MOVEM T,-2(P)
SUBL3Q: SUB P,R70+1
JRST SUBL3A
SUBL3Z: MOVEI B,NILPROPS
JRST SUBL1B
SUBL2: POP P,A
PUSHJ P,SBL1
JFCL
MOVEI R,0 ;REMOVE ALL "SUBLIS" PROPERTIES
SUBL3A: MOVE TT,(P)
SUBL3: CAIN R,(TT) ;REMOVE "SUBLIS" PROPERTY
JRST SUBL4
HLRZ T,(TT)
HLRZ T,(T)
JUMPN T,.+2
MOVEI T,NILPROPS
HRRZ B,(T)
MOVE B,(B)
HLRZ D,B
HRRZ B,(B)
CAIN D,QSUBLIS
HRRM B,(T)
HRRZ TT,(TT)
JRST SUBL3
SUBL4: SUB P,R70+1
JRST CZECHI
SBL1: SKOTT A,LS ;TRACE THROUGH STRUCTURE IN (A) SUBSTITUTING
JRST SBL2 ;(GET 'U 'SUBLIS) FOR U WHEREVER IT IS NON-NIL
PUSH P,A
HLRZ A,(A)
PUSHJ P,SBL1
JRST SBL4
EXCH A,(P)
HRRZ A,(A)
PUSHJ P,SBL1
JFCL
HRRZ B,(P)
SBL5: SUB P,R70+1
PUSHJ P,XCONS
JRST POPJ1
SBL4: HRRZ A,@(P)
PUSHJ P,SBL1
JRST POPAJ
HLRZ B,@(P)
JRST SBL5
SBL2: TLNN TT,SY
JRST SBL2B
HRRZ B,(A)
SBL2A: HLRZ T,(B)
CAIE T,QSUBLIS
POPJ P,
HRRZ A,(B)
HLRZ A,(A)
JRST POPJ1
SBL2B: JUMPN A,CPOPJ
HRRZ B,NILPROPS
JRST SBL2A
SUBTTL SAMEPNAMEP AND ALPHALESSP
¬
SAMEPNAMEP: TDZA D,D ;USES ONLY A,B,T,TT,D
ALPHALESSP: MOVEI D,QLESSP ;MUST PRESERVE C,AR1,AR2A,R,F (see SORT)¬
SKOTT A,SY
↓ JUMPN A,ALPL4
SKOTT B,SY
JUMPN B,ALPL5
ALPL0: PUSH P,B
PUSHJ P,PNGET
EXCH A,(P)
PUSHJ P,PNGET
POP P,B ;FROM NOU ON, A HAS PNAME OF 2ND ARG, B OF 1ST
JRST ALPLP1
ALPL3: HRRZ A,(A)
HRRZ B,(B)
ALPLP1: JUMPE B,ALPL2
JUMPE A,FALSE ;ON SAMEPN, LOSE IF 2ND ARG RUNS OUT BEFORE 1ST
HLRZ T,(A) ;ON ALPHAL, LOSE IF 2ND ARG IS SHORTER THAN 1ST
MOVE T,(T)
HLRZ TT,(B) ;FOR SAMEPN, WILL RETURN NIL IF
;TWO ARE UNEQUAL INSOME PLACE
CAMN T,(TT) ;NO INFO IF CORRESPONDING PLACES ARE EQUAL
JRST ALPL3
JUMPE D,FALSE ;BUT NOT EQUAL IN SAMENAMEP MEANS LOSE
MOVE TT,(TT) ;MUST DO SOME HAIR FOR THE ALPHALESSP
LSHC T,-1 ; COMPARE TO WIN, SINCE PNAME WORDS ARE
CAMG T,TT ; LOGICAL DATA, NOT ARITHMETIC
JRST FALSE ;2ND ARG STRICTLY LESS THAN FIRST
JRST TRUE ;2ND ARG STRICTLY GREATER THAN FIRST
ALPL2: EXCH A,D
JUMPE D,NOT ;IF ALPHAL, WIN WHEN A NON-NUL
;[FOR 1ST ARG IS PROPER SUBSTRING OF 2ND]
POPJ P, ;IF SAMEPN, WIN WHEN A NUL
;[FOR CORRESPONDENTS HAVE BEEN EQUAL ALL ALONG]
ALPL5: EXCH A,B ;FIRST ARG SYMBOL, SECOND ARG ISN'T.
PUSHJ P,ALPL6
JRST [EXCH A,B
JRST ALPL0]
SKIPE D
MOVEI D,QGREATERP
JRST ALPL7
ALPL4: PUSHJ P,ALPL6
JRST ALPL0
ALPL7: PUSHJ P,[PUSH P,A
SKIPN D
MOVEI D,QSAMEPNAMEP
PUSH P,D
PUSH P,B
MOVNI T,3
XCT SENDI ;Send the object a message
]
ALPL5X: PUSHJ FXP,RST5M1
JRST POP1J
;; CHECKS TO SEE IF ACC A HOLDS A USER HUNK. SKIPS IF SO.
ALPL6: SKIPE USRHNK ;IF USERHUNKS NOT ENABLED, OR IF THIS NON-SYM
TLNN TT,HNK ; ARGUMENT ISN'T A HUNK, THEN LET PNGET BARF
POPJ P, ; ABOUT NOT GETTING A SYMBOL
PUSHJ P,USRHNP ;IS IT A USER-HUNK?
JUMPE T,CPOPJ ;NOPE, SO EXIT WITH NO SKIP
POP P,T
PUSHJ FXP,SAV5 ;YES, SO SKIP AND LEAVE ACC'S STACKD UP
JRST 1(T)
SYSP: MOVEI B,TRUTH ;SUBR 1 - DETERMINE WHETHER SYMBOL HAS
SYSP3:
10% CAIGE A,BEGFUN ; A "SYSTEM" SUBR PROPERTY
10$ CAIL A,ENDFUN
JRST FALSE
10% CAIG A,ENDFUN
10$ CAIL A,BEGFUN
JRST BRETJ
CAIGE A,BSYSAR ; ... OR MAYBE A SYSTEM ARRAY PROPERTY
JRST SYSP6
CAIGE A,ESYSAR
JRST BRETJ ;RETURNS T FOR SUBR/SAR POINTERS
CAIE B,QAUTOLOAD
JRST SYSP6
CAIL A,BSYSAP
CAIL A,ESYSAP
JRST FALSE
JRST BRETJ
SYSP6: JSP T,SPATOM ;RETURNS FALSE FOR NON-SYMBOLS
JRST FALSE
PUSH P,A ;TRY THE AUTOLOAD PROPERTY FIRST
MOVEI B,QAUTOLOAD
PUSHJ P,$GET
JUMPN A,SYSPZ
SYSPZ1: POP P,A
MOVEI B,ASBRL
PUSHJ P,GETL1
JUMPE A,CPOPJ ;RETURNS FALSE FOR SYMBOLS WITH NO FN PROPS
HLRZ B,(A) ;RETURNS NAME OF PROPERTY OF ONE IS FOUND,
JSP T,%CADR
JRST SYSP3 ; AND THE PROPERTY VALUE PASSES THE SYSP TEST
SYSPZ: CAIL A,BSYSAP
CAIL A,ESYSAP
JRST SYSPZ1 ;AUTOLOAD PROPERTY NOT SYSTEM'S - GO ON
POP P,A ;ELSE FLUSH STACK OF A
MOVEI A,QAUTOLOAD ;AND RETURN AUTOLOAD
POPJ P,
GCTWA: JUMPE A,GCTWI
HLRZ A,(A)
PUSHJ P,NOTNOT
MOVEM A,VGCTWA
JRST GCTWX
GCTWI: SETOM IRMVF
GCTWX: MOVEI A,IN0
SKIPGE IRMVF
ADDI A,1
SKIPE VGCTWA
ADDI A,10
POPJ P,
SUBTTL COPYSYMBOL FUNCTION
COPYSYMBOL:
JSP T,SPATOM
JSP T,PNGE
CPSY3: JUMPN B,CPSY0 ;IF NON-NIL SECOND ARG COPY PLIST, VC AND ARGS
CPSY: PUSHJ P,PNGT0 ;COPY THE SYMBOL
JRST SYCONS
CPSY0: PUSH P,A ;SAVE OLD SYMBOL
PUSHJ P,CPSY ;GET A NEW COPY
EXCH A,(P) ;SAVE NEW COPY, GET OLD
PUSH P,A ;SAVE OLD ON TOP OF STACK
HRRZ A,(A) ;GET PLIST
JUMPE A,CPSY1 ;IF NO PLIST THEN TRY VALUE CELL
MOVEI B,NIL ;NOW GET A NEW COPY OF THE PLIST
PUSHJ FXP,SAV5M3
PUSHJ P,.APPEND
PUSHJ FXP,RST5M3
HRRM A,@-1(P) ;STORE IN NEW SYMBOL
CPSY1: SKIPN A,(P)
JRST CPSY4
HLRZ A,(A) ;POINTER TO OLD SYMBOL BLOCK
HLRZ T,1(A) ;ARGS PROPERTY
JUMPE T,.+3 ;IF NONE THEN DON'T HACK
HLRZ TT,@-1(P) ; ELSE COPY THE ARGS PROPERTY
HRLM T,1(TT)
HRRZ A,@(A) ;GET CONTENTS OF VALUE CELL
CAIN A,QUNBOUND ; IF UNBOUND DON'T BOTHER COPYING
JRST S1PAJ
CPSY4: EXCH AR1,-1(P) ;ELSE COPY VC BY DOING A (SET NEW OLD)
JSP T,.SET
EXCH AR1,-1(P)
JRST S1PAJ
αSUBTTL SETSYNTAXAND OTHER READER SYNTAX FUNCDIONS
;ARGS ARE CHAR (AS NUMBER OR ATOM), SYNTAX-CODE, MACRO-OR-TRANSLATION
SETSYNTAX: SETZ AR1, ;SEBR 3
MOVEI AR2A,(B)
↓JSP T,SPATOM
JRST RSSYN1
JSP T,CHNV1
JSP T,FIX1A
RSSYN1: CAIN AR2A,QMACRO
JRST RSSYN2
CAIE AR2A,QSPLICING
JRST RSSYN3
MOVEI AR1,[QSPLICING,,NIL]
RSSYN2: MOVE B,A
PUSH P,CPRUE
PUSH P,AR1
JRST SSMC43
RSSYN3: MORSI AR1,40000 ;WAY TO FAKE OUT SSYN0
MOVEI B,(A)
JUMPE C,RSSYN5 ;SKIP IF NO CHTRAN STUFF
PUSHJ P,RSSYN4
HRRZM A,(FXP)
MOVEI A,(B) ;LOSING RETROFIT FOR NSTST
MOVEI B,(C)
PUSHJ P,SSCHTRAN
SUB FXP,R70+1
RSSYN5: JUMPE AR2A,TRUE ;XIT IF NO SYNTAX STUFF
CAIE AR2A,QSINGLE
JRST RSSYN7
NW% PUSH FXP,[600500]
NW$ PUSH FXP,[RS.SCS]
MOVEI C,(FXP)
JRST RSSYN8
RSSIN7: MOVA C,AR2A
PUSHJ P,RSSYN4
HLRZS (BXP)
RSSYN8*
MOVEI A,(B) 9HOSINC RETROFIT FOR NSTAT
MOREI B,(C)
↓PUSHJ P,SSCYNTAX
SUB FXP,R70+1
CDRUE: JRST TRUE
RSSYN4: PUSH FXP,R70
MOVEI A,(C)
JSP T SPATOM
POPJ P,
MOP
∩↓εPQ∧$∩w'βY
A∧~(∪∃' ↓(Yπ⊃9(b
∀%≠↔- $AαXQQ(R
∀%≠∨- $A∧XQ R∩w∀*NB>∀)αλ4PJ6.Z,Iα
1D2bA∧KZN⊗Q∧→αR≥∧∩∃α~MB:V5∧z9αR⎇↓α>→¬α∩04PJ*NA¬!2JNE~P4(Lj>Z∃¬"Q2α∃~bRλhP&6>4*5αR"a"~BαH4(&∧zB)αα`4(04*≥~∞"R∀
9h4Tr]∀&≤Z&B¬∧12n"∃∩5αIbBRQ&hh*:] JN.&∧ α→2\"B α∩bmAA AA.%!12vhh*NN≥J:RεCP4*::(&6>5~%α→bB"J2jαI1"%!%$4Tr]⊂&lzZ¬α2bn2∩⊂αI2m MMAαZRQ1ejt4(MαVN!¬↓2nN¬∩>≥Nhh(&6⎇2N%α
⊃E!Qβ↓A@$KZ2>NLr≥α∞∀z∞,4U~NNfs h4(Lj>Z⊗Jα
1"∩H%n2⎇~&:≥∧~J>∞Xh(&6⎇2⊗%α∩a"¬$hP&BV≤B)αAd:J∞RHH%n≡-!α&:$*aα~⎇⊃αJ∞"α&:Rzα⊂4(M"2:∃∧
IE1#↓AA@HImAAβ↓Aα
M!αNεM→α⊗Z a↓NJ"αεJ≤hP&*NααQ2~DrYL4PJ*NA¬!2N6≥⊃H$%\b>∞-∧
:⊃α≤*RVA¬∩∞Qα
∩Jεe¬αRIαLrR=α% 4(& "∩%α%!1"⊃Hh(&b≥!α_$KZ6εe¬~.&AαB~>IαBNRε%*Mα∞E"Jε9JH4(&,r2.B⎇α(%nm*NQα∀)α>:eIα>:*α&:N%∩V∞RLz984Tr]∀&$b:¬α%!1QAβ%nN\JAαVtb⊗NM∧jε∞Jzα∞"ε⊂h*:] JR2:*αRQ1E∩M:6 →%nN\JAαVtb⊗NM∧jε∞Jzα∞"ε⊂h(&6⎇2⊗%α%!1"⊃HInVN*α∞"ε∀
∞R⊗∩αεMαM"Mα><qα∞"%∩ε84PJR2i¬"Q15λh(&Vtb.B>∧P4(4T:J∞RKP&*NααQ2~DrYH%\:⊗Qα∀*ε∩R ∩2∃αLr∩⊗@hRN¬∀L~ε&≡*α⊃2:
~∞&$hRN¬⊂L~ε&≡*α⊃1Eβ @4(LRV6B<)α⊃2≥α>B(hP&*J≥!α≡J≥"&∀4Ph*N6 ~J=hhP&6>4*%α bB¬$4PJBVNDQαA2=∩∞R$hP&*NααQ2Nl~IH4PJε∩⊃¬"Q2⊂hRN6∞∪ h&6⎇2⊗%α
b:&0hP&6>4)α
1E"Q$4PJV:2|~.$4Tr]∀&$b:9α~aQAAh*:] JR2:rα
1"∃→:6ε~H4(&∧zB)αα`$$%\*b&Q¬:&R!∧r&1αL1α:=∧jε∞Jzα∞"ε⊂h*:](JR2:*α
1Qh*:] JRJ:*α
"J~rε2PhP&6>4*%α¬e
NB2L~&*≤KZNB2L~&*≥¬"fB∀hP&BV≤B)αAdr∞>:_h*:](J6>Z,Iα 1D→$4*u9⊂&B-~!αAbα∧4*u9⊂&B-~")ααaα≡⊗$jε 4Tr]⊂&E∩Jiα⊂a↓"¬HH%n∞%⊃α>→∧
NNE∧JMα~,r∞R&|p4*:: &B>ααA1αλh(&B-~")ααbb∞>u_4(&∧zB)αα`4(∀TJ~9αt*↑J⊃eX4)m[ZJ>V$J:∃α$yα≡⊗"α6ε∞∀yα⊗:%∩e9α≤BεIαLqα⊃8hQmmlL~2>
∀*JMα
aα 1¬"Q1α∀*RVJu→↓"∞D
I↓9∧2∞9%∧J9α∧hQmmlM∩NbN α6VN"α"εZ*α
ε⊗rα∩>:(h*≡⊗$jε
hLj>Z⊗Jα¬1↓∪↓X$%\:⊗Qα4~9α2M~Qα~∀z5αJ,
∩Rε∀b∀4(LBJJi∧⊃1αα∃~bRλHIe98hP&6>4)α¬1∧ $%n≤BεJε≥"⊗H4PJBVNDQαA1∧JεNN 0$%n$*B⊗:%→α>9∧!2I22α
⊗&t9αBJ-~⊗JZ, 4(&U*6B∃∧ 1αnd*JIα]~&b
M!>&ε≥∩=α∞D
Jε∞$*IαZ r&N",!
¬¬⎇jt4(Mα>B)¬↓04*hH%n⊗t!α>→∧J~9αt*↑J⊂hP04*≥~6ε∞∀yh4(L~ε6∃¬!2b
k_$%n≥∩>∞-¬"=α≡-!α:N$
QαVαα~εN h(%α¬*N!ααbI]@hP&B>ααA2∧hP&B>ααA2 hP&B>ααA2λhP&N.Mα∃α∧hP%αB-~")ααbε∞>u_4(&¬*N!ααb∧4*≥~6
Q≠P&BV≤B)αAd:J∞RHh(&*≥↓αQ2≤j∞IHhP&ε∩"αRQ2 h(&"∃∩j5α%!2J5 h(&*,jB¬α~bNN5λh*:](J"J2Jα
#FεC+β↓Q$u:A→T⎇∀Tλ2e]*5d≤m;QPPM99∃∧*λ∃BEα⊃Q LU*:B¬≥9V0hU:9S#PQ!∀-D9∧∧
d
)S h)jr(L
*%R∧∃H0hTjtPM$IhR∧~FFββQ)e:(~
U≤D$
αe≥8x5∀,A↔4≤dx($-∃4λ0hT_ib∧tZz$"e1Q M$Iib∧~E
%~tX_2Hh!→%∃≥D
5≤kH_⊂hP~
U≤D$
αb∧xZDl 1Q#]∀YYu4*
$-4→zU~∧X_5∀zλjTt≥I→tr∧j)tj∧~:5
∧I~5"pQ'2RR%!∩E≤ZJ∩∧l_5TdM:DαD$YJ∩∧
X∀~lI~5"J∀¬"RR!Q%≥≤VH∀ P⊃↔4 tD dz∧x:$,bλ:%,5D d,≤5aPPMQQ LlzhR∧~H
$k Q)e:(→
%∃Rλ∃D_h)jr(MIId*∧5FCββ↓Q$u:Q~¬-≤ $¬αe:8t≥¬)qPTutQ∀E∃)P∧
d
)S h)jr LJλ"∧"D 3ββ⊗⊗βαbH
$k%Q↔4l 8)u~∧ZZ5"∧λ~d*¬8YD2∧~4∧≤EJ(∀ph)jr LYzd*∧%D∧ K5%"U≥X(TeJ
I∧M~λ9u,dDλ$*∧∀ D⎇" HU≥~ 9E,$x[∩RR!Q$u:A~¬-≤ $¬αb λ4|U1Q$u:A→T⎇4Tλ"b∧⊃Q$u:A→T⎇4Y∀∧
bε&β0h)jr LYzd*∧∃D∧¬∃;
D⊂h)jr M
Z4DR
¬B¬D9ye_h)jr LYzd*∧%D∧λh)jr LYzd,Jλ∃Bβ∪εaPTutA∀l⎇hYR∧∩Dλ¬∃≥
H hP~:T∩¬¬J#;α6⊃PPLYzd*¬JEE∀kAQ LU*:B¬≤X:#λh!Q%≥≤V7 LlzhTJ∧~&∩bD%⊃PPL J%R∧∃E∧
HQ!∀U≥∧
Bd≤ jcλh!_4 Ld
E"b*1⊂K]: DL≤→huh)jr(MIIr∧~FFhTjt@M%)t∧~e*5d eAQ LlzhTJ∧%E∧
∪∃⊃PPL**5"¬:9S h!Q%≤l:&#PLIx4\HQ!∀U∃:D¬∃≥
:@hPQ*5≤k↔!∀E∀I∀∧"c!Q LlzhR∧~J(5#αλE⊂hTjtPM$IhR∧~FFββ↔:t
~ ~B∧⎇)_tLt→IEJ∧∀ T ≥)t∧≤D~'phTjt@M$IhR∧~E
%~tX_2Hh!→T⎇4Tλ2d Q!∀U∃:D¬≥≤VAPPh!Q hPQ!PU≥8x5∀,G!∃$%(∀∧"dA↔4m-:D∧D
hT¬-≤Z$∧LuHZ%∃-
J2∧|haPU≥8x5¬∀w!∀l⎇hY∩∧"F⊃PPL*:α¬"J:∧
$yQPPJ *%≥"
:4<≥ε⊃PPL J%R¬EE∧
H⊃↔4<-D
5Ll)yB∧∀Ix4Zbλi∃∃≥D
t⎇∀AQ LlzhR¬"E
BHh!~DdtT
Be≥∃h4≤p⊃↔4L2
;∀j∧izB¬¬)zD,≥HXB∧∀X8∃-≤T t2∧(Y∀t8Q!∩¬∧z "¬αA⊃∪Zα)hT,$XD"∧∃∀λ4|m →D,"λ9t$*D
DD,d
¬∀|I~2lLk⊃PU≥8x5β !~4⎇4Tλ∩∧⊂Q!∀E∃+$¬∩bλ%⊂hP_8∀L<T
"c∪ε↓PPL
)B¬∩Jj$, JH∀∀dQQ LE*)∩¬∩I→cαE%⊃PPLYzd*∧%J¬∀|I~0hP→*Tm∧TλBe≥8z$cλQ!∃¬-9 "¬αH~5≤|1Q LUYZ∧*∧∃J5≥¬)z⊂hP→ E∃Rλ∃BD
⊃Q LlzhTj∧∃ES
E¬⊃PU≥:
$⎇ !→T⎇4Tλ"e⊂Q!∃¬-9 "¬αH9tu≠ MOVE B,-1(P)
PUSHJ P,XCONS
MOVE B,PROLIS
PUSHJ P,CONS
MOVEM A,PROLIS
MOVE A,-1(P)
SSPROX: POP P,B
JRST POP1J
SSGRL2: MOVE A,-1(P)
SSGRL1: PUSHJ P,IASSQF ;INTERNAL ASSQ WITH NO CHECKING
JRST SSPROX ; NO SKIP ON FAILURE TO FIND
HRRZ B,(B) ; SKIP ON SUCCESS
HRRZ T,(A)
CAME R,(T) ;COMPARES READTABLE AND NUMBER
JRST SSGRL2
MOVE B,PROLIS
PUSHJ P,.DELETE
MOVEM A,PROLIS
MOVEI A,NIL
JRST SSPROX
AUTOLOAD: ;T SHOULD CONTAIN THE SYMBOL NAME, A SHOULD
HRL A,T ; CONTAIN THE AUTOLOAD PROPERTY
PUSHJ P,ACONS
MOVSS (A)
PUSH P,A ;FOR GC PROTECTION
PUSH FXP,D
MOVSI D,(A)
HRRI D,1000 ;AUTOLOAD USER INTERRUPT
PUSHJ P,UINT
POP FXP,D
JRST POP1J
IFN ITS,[
SUBTTL SYSCALL FUNCTION
SYSCALL:
MOVEI D,QSYSCALL
CAML T,[-10.]
CAMLE T,XC-2
JRST WNALOSE
MOVEI D,2(P)
ADD D,T ;D POINTS TO ARG WITH .CALL NAME IN IT
MOVNM T,SYSCL8 ;#ARGS+2
JSP T,0PUSH+2(T) ;PUSH SLOTS FOR COPYING FIXNUM ARGS
SCSL0: MOVE A,-1(D)
JSP T,FXNV1 ;<CONTROL-BITS>,,<NUMBER-OF-OUTPUTS-DESIRED>
HLL D,TT
HRRZS TT
CAILE TT,20
JRST SCSTMA
HRLM TT,SYSCL8 ;#ANSWERS,,#ARGS+2
MOVE A,(D)
PUSH FXP,D
PUSHJ P,SIXMAK
MOVSI D,(SETZ)
EXCH D,(FXP) ;THE SETZ GETS PUT OUT HERE
MOVEI R,-1(FXP)
MOVEI F,(FXP)
PUSH FXP,TT ;THE SIXBIT FOR THE NAME OF THE .CALL
HLRZ T,D
TLZ D,-1
TLO T,5000 ;THE CONTROL BITS ARG
JRST SCSL1A
SCSL1: HRRZ T,(D)
SKOTT T,FX
JRST SCSL1A
MOVE TT,(T)
MOVEM TT,(R)
MOVEI T,(R)
SUBI R,1
SCSL1A: PUSH FXP,T
MOVEI AR1,(T)
CAIN AR1,TRUTH
MOVEI AR1,TTYIFA
MOVEI T,(AR1) ;THIS IS AN INLINE CODED XFILEP
LSH T,-SEGLOG
MOVE T,ST(T)
TLNN T,SA
JRST SCSL6
MOVE T,ASAR(AR1) ;MUST ALSO HAVE FILE BIT SET
TLNN T,AS.FIL\AS.JOB ;ALLOW EITHER JOB OR FILE
JRST SCSL6
MOVE TT,[@TTSAR]
ADDM TT,(FXP)
SCSL6:
CAIGE D,(P) ;LOOP TO INSTALL REMAINING INPUT ARGS
AOJA D,SCSL1
HLRZ D,SYSCL8
SOJL D,SCSL4
MOVEI T,1(FXP)
HRLI T,2000
SCSL3: PUSH FXP,T ;LOOP TO INSTALL ANSWER REQUESTS
ADDI T,1
SOJGE D,SCSL3
SCSL4: MOVSI T,(SETZ) ;FINAL SETZ SIGNALS END OF PARAMETERS
IORM T,(FXP) ;[THERE WILL ALWAYS BE AT LEAST ONE, I.E. THE CONTROL]
MOVEI TT,F.CHAN
.CALL (F)
JRST SCSFAI
SETZB A,B
HLRZ D,SYSCL8
SCSL5: JUMPE D,SCSXIT ;LOOP TO LISTIFY UP NUMERIC ANSWERS
POP FXP,TT
PUSHJ P,CKNSFX
SOJA D,SCSL5
SCSTMA: MOVEI TT,15
JRST SCSXT1
SCSFAI: .SUSET [.RBCHN,,R]
.CALL SCSTAT
.VALUE
LDB TT,[220600,,D]
MOVE D,SYSCL8
HLRS D
SUB FXP,D ;TAKE OFF THE SLOTS FOR ANSWERS
JSP T,FXCKNS ;LISP NUMBER FOR ERROR CODE
SCSXIT: MOVE D,SYSCL8 ;SYSCL8 HAS 2+#ARGS
ADDI D,-1(D) ;PUSHED WAS 3+2*!ARGS
HRLS D ; WHICH IS 2*SYSCL8-1
SUB FXP,D
SCSXT1: MOVE D,SYSCL8
HRLS D
SUB P,D ;STRAIGHTEN UP P
POPJ P,
SCSTAT: SETZ
SIXBIT \STATUS\ ;GET CHANNEL STATUS
,,R ;CHANNEL #
402000,,D ;STATUS WORD
.SEE IOCERR
,SEE CHNI1
] ;END OF IFN ITS
$INSRT STATUS ;HAIRY SDATUS FUNCTIONS
SUBTTL CURSORPOS FUNCTION
IFN USELESS,[
CURSORPOS:
MOVEI D,QCURSORPOS ;LSUBR (0 . 3)
CAMGE T,XC-3 ;MORE THAN THREE ARGS LOSES
JRST WNALOSE
JUMPE T,CRSRP0 ;IF NO ARGS, IS FOR DEFAULT TTY
CRSRPS: SKIPN AR1,(P) ;ELSE LAST ARG MAY BE TTY FILE ARRAY
JRST CRSRN
MOVEI TT,(AR1)
LSH TT,-SEGLOG
SKIPGE ST(TT)
JRST CRSRMP
CAIN AR1,TRUTH ;LAST ARG = T
HRRZ AR1,V%TYO ; MEANS THE DEFAULT TTY
CRSR10: CAMN T,XC-3 ;FOR THREE ARGS MUST HAVE A FILE ARRAY
JRST CRSRP8
JSP TT,XFOSP ;FOR ONE OR TWO ARGS MAY OR MAY
JRST CRSRP0 ; NOT HAVE A FILE ARRAY
IFN SFA,[
JRST CRSFA1 ;FILE
CRSFA5: SUB P,R70+1 ;SFA
CRSFAY: SETZ C,
AOJE T,CRSFA2 ;ONE LESS ARG; ONLY 1 ARG, ARG TO SFA IS NIL
POP P,A ;LISTIFY THE ARGS
PUSHJ P,NCONS ;GENERATE THE INITIAL LIST
AOSN T ;TWO ARGS?
JRST CRSFA4
POP P,B
JSP T,%XCONS ;NOW THE LIST IS IN A
CRSFA4: MOVEI C,(A)
CRSFA2: MOVEI B,QCURSORPOS ;CURSORPOS OPERATION
MOVEI A,(AR1) ;THE SFA ITSELF
JRST ISTCSH
CRSFAZ: HRRO AR1,V%TYO ;GET FILE AS SPECIFIED BY 'T'
JSP TT,XFOSP ;CHECK FOR IT BEING A SFA
JRST (F) ;NOPE
JRST (F)
SOJA T,CRSFAY ;A SFA, HANDLE SPECIALLY
] ;END IFN SFA
CRSRP8:
IFN SFA,[
JSP TT,XFOSP ;CHECK IF FILE OR SFA
JFCL
SKIPA ;NOT SFA
JRST CRSFA5 ;SFA
CRSFA1: ] ;END IFN SFA
SUB P,R70+1 ;IF WE HAVE ONE, IT MUST
PUSH FXP,T ; BE A BONA FIDE TTY OUTPUT FILE
PUSHJ P,TOFLOK
UNLOCKI
POP FXP,T
↓AOSA D
CRSRP0:
SFA% HRRO AR1,V%TYO
SFA$ JSP F,CRSFAZ ;TRAP OUT IF A SFA
JSP R,PDLA2(T)
MOVEI TT,F.MODE
MOVE D,@TTSAR(AR1)
SKIPGE AR1 ;IF FILE NOT EXPLICITLY GIVEN
SKIPN TTYOFF ; THEN ↑W NON-NIL => REPURN NIL
SKIPA
JRST FALSE
JUMPE T,CRSRP1 ;0 ARGS - GET POSITION
AOJE T,CRSRP3 ;1 ARG - SPECAAL HACKS (↑P CODES)
SKOTT A,FX
JRST CRSR11
¬
;2 ARGS
MOREI D,"V ;SET VERTICAL POSITION
PUSHJ P,CRSRP5
CBSR20: MOVEI D$"H ;CET HORIZONTAL POSITION
MOVEI A,(B)
CRSRP5* JUMPE A,TRUE ;LIL MEANS NO CHANGE
JSP T,FXNV1
SKIPGE TT
∩AM )4AQ(X∩∩m≥β∂βQ∪%
A¬%∞A≥=(Aβ→1≠ ≡⊗ h(&∞ J2¬ααJBc fq⊂K\iz"∧
(p∧ ∀zhRβ fqPPJ Yu$,∀
E"c⊗fphT_ib∧MJ;D#∪¬A∀E∀I∀∧"c⊗¬¬%"⊃⊃∪L H@∧l y_2β ∧
Dj∧→Yu,uDλd⎇∩ jhRhYE≤*↓→%∃≥Dλd E8QPPh!Q$≥∃:*β+P~
U≤D$λdeαH9e∧≤ 1⊂K\9λT Z
Ir¬≤XT∧L2λ8∃∧ )→DM%∀λUDM:J3xh!∀∧U∃:@∧≥∃:&sλh)_dr∧~J5d#&¬@LlzhTJ∧∃JE∃-I↓⊂K](ZE-∀d
E∃-I∧L2
xR∧<zD¬$D~4∧4
!Q"t J8PLlzhTJ∧∃IdL`⊃⊃∪M∀_y¬"∧izrb∧F⊗α¬≥EMS CANT "DO IT"
JRST CNPCUR ; THEN DO ACTION, AND EXIT WITH CZECHI
CRSR71: MOVEI A,NIL ;NO CAPABILITY, SO RETURN NIL
JRST CZECHI
;1 ARG CASE
CRSRP3: JSP T,SPATOM
JRST CRSRP4 ;IF NO A SYMBOL, THEN BETTER BE FIXNUM
PUSHJ P,CRSR40 ;GET NUMERIC VALUE OF FIRST CHAR OF SYMBOL
CRSRP6: MOVEI D,(TT)
TRC TT,100
TDNE TT,[-40]
JRST CRSRP2
MOVE TT,GCBT(TT) ;Get a "1" bit in the position specified by TT
TDNN TT,CRSRP9
JRST CRSRP2
JRST CRSRP7
CRSRP4: JSP T,FXNV1
JRST CRSRP6
CRSR40: JSP T,CHNV1
CAIL TT,140
SUBI TT,40 ;CONVERT TO UPPER CASE
POPJ P,
CRSRP9:
ZZZ==0
IRPC X,,[ABCDEFKLMNPQRSTUXZ[\]↑←]
ZZZ==ZZZ\<SETZ←-<"X&37>>
TERMIN
ZZZ ;BITS SPECIFYING VALID ↑P CODES
EXPUNGE ZZZ ;NOTE: H, I, AND V NOT VALID HERE!
;2 ARG CASE WITH NON-FIXNUM AS FIRST ARG
CRSR11: JUMPE A,CRSR20
JSP T,SPATOM
JRST CRSR12
PUSHJ P,CRSR40
JSP T,FXNV2
SKIPGE D
SETZ D,
CAIE TT,"H
CAIN TT,"V
JRST CRSR13
CAIN TT,"I
JRST CRSR14
CRSR12: WTA [BAD CURSOR CODE - CURSORPOS!]
JRST CRSR11
CRSR13: CAILE D,167
MOVEI D,167
ADDI D,10 ;H AND V RANDOMLY WANT 10 ADDED
CRSR14: MOVSI D,400000(D) .SEE CNPCD1 ;KEEP LH FROM BEING ZERO
HRRI D,(TT)
JRST CRSRP7
;0 ARGS CASE
CRSRP1: PUSHJ P,FORCE1
MOVEI TT,F.MODE
MOVE F,@TTSAR(AR1)
IFE ITS\D20, JRST FALSE
IFN ITS\D20,[
PUSHJ FLP,RCPOS
TLNE F,FBT<EC> ;GET ECHO MODE POSITION
MOVE D,R ; IF FILE IS FOR ECHO AREA
MOVEI TT,(D) ;CONS THEM UP FOR LOSER
JSP T,FIX1A
MOVEI B,(A)
HLRZ TT,D
JSP T,FIX1A
JRST CONS
] ;END OF IFN ITS\D20
CRSRMP: PUSH FXP,T
CRSRM1: HLRZ A,@(P)
MOVE T,(FXP)
MOVEI TT,(T)
ADDI TT,(P)
PUSH P,1(TT)
TRNE T,1
PUSH P,2(TT)
PUSH P,A
PUSHJ P,CRSRPS
HRRZ A,@(P)
MOVEM A,(P)
JUMPN A,CRSRM1
POP FXP,T
CRSRN: MOVEI A,TRUTH
JRST PROGN1
] ;END OF IFN USELESS
SUBTTL RANDOM ROUTINES TO HANDLE A PSEUDO ALIST
%%FUNCTION: MOVEI D,Q%%FUNCTION
JUMPE A,WNAFOSE
HRRZ C,(A)
JUMPN C,WNAFOSE
HLRZ B,(A) ;HALF-ASSED FUNARG BINDING
HRROI TT,(SP) ;ONE LH AS GOOD AS ANOTHER
JSP T,FIX1A
.FUNC4: PUSHJ P,XCONS
MOVEI B,QFUNARG
JRST XCONS
AEVAL: SKIPE A,(P) ;PURPOSELY CRIPPLING POWER OF ALIST
JSP T,FXNV1 ; ROUTINE: FOOEY! - GLS
PUSHJ P,ALIST ;EVAL WITH AN ALIST
SUB P,R70+1
POP P,A
SKIPE T ;ALIST RETURNING NON-ZEBO IN T =>
PUSH P,CAUNBIND ; TWO BIND BLOCKS WERE PUSHED
PUSH P,CAUNBIND
POPJ FXP,
;;; ALIST CREATES AN ENVIRONMENT AS SPECIFIED BY A GIVEN A-LIST.
;;; AN A-LIST MAY BE:
;;; [1] NIL, MEANING THE TOP-LEVEL ENVIRONMENT.
;;; [2] T, MEANING THE CURRENT ENVIRONMENT (SEE [4]).
;;; [3] A FIXNUM REPRESENTING A SPECPDL POINTER, AS
;;; RETURNED BY THE EVALFRAME FUNCTION AS THE FOURTH
;;; ITEM. THIS INDICATES THE ENVIRONMENT AS OF
;;; THE SPECIFIED FRAME.
;;; [4] ((<SYMBOL> . <VALUE>) . <A-LIST>)
;;; THAT IS, ONTO ONE OF THE OTHER THREE KINDS OF A-LIST
;;; ONE MAY CONS ADDITIONAL VARIABLE-VALUE PAIRS IN
;;; THE USUAL MANNER. THIS IS A "TRUE A-LIST".
;;; THIS ENVIRONMENT IS CREATED BY REBINDING ALL VARIABLES
;;; WHICH HAVE BEEN BOUND SINCE THEN BACK TO THEIR OLD VALUES,
;;; OR TO THE VALUES SPECIFIED BY THE TRUE A-LIST. IF A GIVEN
;;; VARIABLE WAS BOUND SEVERAL TIMES, ONLY ONE REBINDING IS DONE
;;; TO RECREATE THE OLD ENVIRONMENT. THIS IS DONE BY USING THE
;;; LEFT HALF OF A VALUE CELL TO INDICATE WHETHER OR NOT IT
;;; HAS ALREADY BEEN REBOUND. THIS HAS THE CONSEQUENCE THAT
;;; NOQUIT MUST BE TURNED ON DURING THIS OPERATION.
;;; EITHER ONE OR TWO SPECPDL BLOCKS ARE PUSHED, THE SECOND ONE
;;; BEING NECESSARY IF ANY TRUE A-LIST IS GIVEN. THERE ARE FOUR
;;; STEPS TO THE PROCESS:
;;; [1] CHECK ARGUMENT THOROUGHLY FOR ERRORS. IF A TRUE
;;; A-LIST IS GIVEN, ALL SYMBOLS ON THE A-LIST ARE GIVEN
;;; VALUE CELLS IF THEY DON'T HAVE ANY ALREADY.
;;; [2] TURN ON NOQUIT. IF A TRUE A-LIST IS GIVEN, BIND ALL
;;; THE SYMBOLS AS SPECIFIED, MARKING THE VALUE CELLS
;;; AS THEY ARE BOUND, AND NEVER BINDING A SYMBOL TWICE.
;;; WHEN DONE, PUSH THE TRUE A-LIST ONTO THE SPECPDL
;;; SO THAT AUNBIND CAN RESTORE THINGS CORRECTLY.
;;; [3] SCAN THE SPECPDL FROM THE POINT SPECIFIED BY THE
;;; SPECPDL POINTER (FROM THE BOTTOM IF NIL), AND BIND
;;; ALL VALUES CELLS SEEN BACK TO THEIR OLD VALUES,
;;; MARKING THEM AS THEY ARE BOUND, NEVER BINDING ONE
;;; TWICE. WHEN DONE, PUSH A POINTER ON THE SPECPDL
;;; SO THAT AUNBIND CAN RESTORE THINGS CORRECTLY.
;;; [4] SCAN BACK OVER ALL THE ITEMS PUSHED IN STEPS 2
;;; AND 3, RESTORING THE LEFT HALVES OF ALL THE VALUE
;;; CELLS. TURN OFF NOQUIT AND CHECK FOR INTERRUPTS.
;;; ON RETURN, A-LIST LEAVES T NON-ZERO IFF TWO BIND BLOCKS
;;; WERE PUSHED. IT IS UP TO THE CALLER TO MAKE SURE THAT THE
;;; BLOCK(S) ARE UNBOUND CORRECTLY WITH AUNBIND.
;;; NOTE THAT ERRPOP CAN RECOGNIZE THESE SPECIAL BIND BLOCKS AND
;;; CALL AUNBIND TO UNBIND THEM. THIS IS BECAUSE THE LAST WORD
;;; PUSHED HAS ZERO IN THE LEFT HALF.
ALIST: SKIPN C,-1(P) ;MAKE COPY OF ENVIRONMENT GIVEN A-LIST
ALST1: JUMPE C,ALST3 ;STEP 1 - ERROR CHECKING
CAIN C,TRUTH
JRST ALST3 ;T AND NIL ARE VALID A-LISTS
SKOTT C,LS
JRST ALST2 ;NOPE - GO CHECK IT OUT
HLRZ AR1,(C) ;YUP - CHECK ITS CAR
HRRZ C,(C)
SKOTT AR1,LS
JRST ALST0
HLRZ A,(AR1)
SKOTT A,SY
JRST ALST0
CAIN A,TRUTH
JRST ALST0
HLRZ AR1,(A)
HRRZ B,(AR1)
MOVEI AR1,QUNBOUND
CAIN B,SUNBOUND
JSP T,.SET1
JRST ALST1
ALST2: TLNN TT,FX ; - DARN WELL BETTER BE A FIXNUM
JRST ALST0
HRRZ TT,(C) ;MUST BE A VALID SPECPDL POINTER
CAML TT,ZSC2
CAILE TT,(SP)
JRST ALST0
ALST3: HLLOS NOQUIT ;TURN ON NOQUIT - MUSTN'T INTERRUPT
HLLOS MUNGP ;ABOUT TO MUNG VALUE CELLS!
MOVEM SP,SPSV ;STEP 2 - PUSH BLOCK FOR TRUE A-LIST
SETZ T, ;T WILL BECOME NON-ZERO IF TRUE
SKIPN C,-1(P) ; A-LIST IS PRESENT AT ALL
ALST3A: JUMPE C,ALST4 ;NIL FOUND
CAIN C,TRUTH
JRST ALST7 ;T FOUND
SKOTT C,LS
JRST ALST4A ;FIXNUM FOUND
HLRZ B,(C)
HRRZ C,(C)
HLRZ A,(B) ;A HAS ATOMIC SYMBOL
HRRZ AR1,(B) ;AR1 HAS ASSOCIATED VALUE
HLRZ B,(A)
HRRZ A,(B)
SKIPGE AR2A,(A) ;SKIP UNLESS VALUE CELL MARKED
JRST ALST3A ;VALUE CELL ALREADY REBOUND
HRLI AR2A,(A) ;PUSH <VALUE CELL,,CURRENT VALUE>
PUSH SP,AR2A ; ONTO SPECPDL; THEN INSTALL
HRROM AR1,(A) ; VALUE FROM ENVIRONMENT, MARKING CELL
AOJA T,ALST3A ;T NON-ZERO => WE PUSHED SOMETHING
ALST4: MOVEI C,SC2 ;NIL => TOP LEVEL ENVIRONMENT
ALST4A: HRRZ C,(C) ;FIXNUM => SPECIFIED ENVIRONMENT
HRRZ B,SPSV
JUMPE T,ALST4C ;IF ANYTHING PUSHED, START NEW BLOCK
PUSH SP,-1(P) ;LEFT HALF BETTER BE ZERO!
PUSH SP,SPSV ;FINISH OFF BLOCK FOR TRUE A-LIST
MOVEM SP,SPSV ;START NEW BLOCK FOR FUNARG POINTER
ALST4C: MOVEI TT,(C) ;STEP 3 - SCAN SPECPDL FROM ENVIRONMENT
ALST5: CAIN TT,(B) ; BACK UP TO POINT WHEN ALIST CALLED
JRST ALST6
HRRZ AR1,(TT) ;GET VALUE FROM SPECPDL
CAMGE AR1,ZSC2 ;IGNORE SPECPDL POINTERS
JRST ALST5A
CAIGE AR1,(SP)
AOJA TT,ALST5
ALST5A: HLRZ A,(TT) ;GET VALUE CELL FROM SLOT
JUMPE A,AL5AB ;IGNORE FROBS ALIST PUSHES!
CAIE A,PWIOINT ;WHAT A LOSER -- DON'T MESS WITH THIS!
SKIPGE AR2A,(A) ;IGNORE MARKED VALUE CELLS
AL5AB: AOJA TT,ALST5
HRLI AR2A,(A) ;ELSE PUSH AS BEFORE
PUSH SP,AR2A
HRROM AR1,(A)
AOJA TT,ALST5
ALST7: HRRZ C,-1(P) ;T => CURRENT ENVIRONMENT
SETZ T, ;ONLY ONE BLOCK PUSHED
HRRZ B,SPSV
ALST6: PUSH SP,C ;STEP 4 - RESTORE VALUE CELLS
ALST6A: CAIN B,(SP)
JRST ALST7A
HLRZ A,(B)
JUMPE A,ALST6B
CAMGE A,ZSC2
HRRZS (A)
ALST6B: AOJA B,ALST6A
ALST7A: PUSH SP,SPSV ;CLOSE BIND BLOCK
HLLZS MUNGP ;VALUE CELLS UNMUNGED
JRST CZECHI ;ALL DONE - CHECK INTERRUPTS
;;; AUNBIND UNDOES A FUNARG BIND BLOCK PUSHED BY ALIST.
;;; IT DOES SO BY SCANNING UP THE SPECPDL FROM THE POINT OF
;;; THE FUNARG ENVIRONMENT, OR BY SCANNING DOWN THE TRUE A-LIST,
;;; CLOBBERING CURRENT VALUNBIND UNDOES A FUNARG BIND BLOCK PUSHED BY ALIST.
;;; IT DOES SO BY SCANNING UP THE SPECPDL FROM THE POINT OF
;;; THE FUNARG ENVIRONMENT, OR BY SCANNING DOWN THE TRUE A-LIST,
;;; CLOBBERING CURRENT VALUES FROI VALUE CELLS INTO SPECPDL
;;; SLOTS OR A-LIST SLOTS AS APPROPRIATE, SO THAT ANY SETQ'S
;;; DONE IN THE CREATED COPY OF THE ENVIRONMENT WILL BE
;;; REFLECTED IN THE ORIGINAL ENVIRONMENT.
AUNBIND:
POP SP,T
AUNBN0: MOVEM TT,UNBND3
MOVEM D,AUNBD
MOVEM R,AUNBR
MOVEM F,AUNBF
MOVEI F,1(T)
HRRZ R,(SP)
CAMGE R,ZSC2
JRST AUNBN4
AUNBN1: CAIN F,(SP) ;CLOBBER SETQ'S BACK INTO SPECPDL
JRST AUNBN3
HLRZ D,(F)
AUNBN2: HLRZ TT,(R)
CAIE TT,(D)
AOJA R,AUNBN2
HRRZ TT,(TT)
HRRM TT,(R)
AOJA F,AUNBN1
AUNBN3: MOVE F,AUNBF
MOVE R,AUNBR
MOVE D,AUNBD
SUB SP,R70+1
JRST UNBND0
AUNBN4: ;CLOBBER SETQ'S BACK INTO TRUE A-LIST
AUNBN5: CAIN F,(SP)
JRST AUNBN3
HLRZ D,(F)
JRST AUNBN7
AUNBN6: HRRZ R,(R)
AUNBN7: HLRZ TT,(R)
HLRZ TT,(TT)
HLRZ TT,(TT)
HRRZ TT,(TT)
CAIE TT,(D)
JRST AUNBN6
HLRZ TT,(R)
HRRZ D,(D)
HRRM D,(TT)
AOJA F,AUNBN5
IAP4A: MOVEM TT,R ;AT THIS POINT, WE MAKE UP AN
HRROI TT,(SP)
JSP T,FIX1A
PUSH P,A
MOVE TT,R
MOVNI R,2
MOVNI T,1
JRST IAP5
APFNG: HRRZ A,(B) ;APPLY FUNARG
HLRZ B,(B)
HRRM B,(C)
PUSH P,A
MOVEM T,APFNG1
PUSHJ P,ALIST
PUSH P,.
HRROI TT,-2(P)
MOVE D,APFNG1
POP TT,2(TT)
AOJLE D,.-1
CAUNBIND:
MOVEI D,AUNBIND
MOVEM D,2(TT)
SKIPN T
MOVEI D,CPOPJ
MOVEM D,1(TT)
MOVE T,APFNG1
JRST IAPPLY
APLBL: HLRZ A,(B)
HRRZ B,(B)
HLRZ AR1,(B)
MOVEM AR1,(C)
MOVEM SP,SPSV ;APPLY LABEL EXPRESSION
PUSHJ P,BIND
PUSHJ P,ABIND3
MOVEI A,APLBL1
EXCH A,-1(C)
HLLM A,-1(C)
PUSH FXP,A
JRST IAPPLY
APLBL1: PUSHJ P,UNBIND
POPJ FXP,
SUBTTL LISTIFY, PNPUT, AND PNGET
LISTIFY:
SKIPN R,ARGLOC
JRST LFYER
JSP T,FXNV1 ;LISTIFY UP N ARGS FOR AN LSUBR
MOVM D,TT
CAMLE D,@ARGNUM
JRST LFY0
JUMPGE TT,LFY3
ADD R,@ARGNUM
SUBI R,(D)
LFY3: HRLOI TT,(D) ;SEE HAKMEM (A.I. MEMO 239) ITEM 156
EQVI TT,(R) ;TT GETS <-N-1>,,<CONTENTS OF ARGLOC>
AOBJP TT,FALSE ;ZERO ARGS
PUSH P,R70
MOVEI R,(P) ;T HOLDS LAST POINTER
LFY1: MOVE A,(TT) ;GET ARG
JSP T,PDLNMK
PUSHJ P,NCONS
HRRM A,(R) ;CLOBBER ONTO END OF LIST
MOVEI R,(A) ;ADVANCE LAST POINTER
AOBJN TT,LFY1
JRST POPAJ
PNPUT: JUMPE B,SYCONS
PUSH P,A
SETZM LPNF
JRST INTRN1
$PNGET: PUSHJ P,PNGET
MOVE C,A
JSP T,FXNV2
MOVEI B,0
CAIN TT+1,7
POPJ P,
CAIE TT+1,6
LERR [SIXBIT \FEATURE NOT YET IMPLEMENTED - PNGET!\]
TDZA D,D
$PNG.R: PUSHJ P,CONSFX
SETZ TT,
MOVE R,[440600,,TT]
$PNG3: TLNN D,760000
JRST $PNG.D
$PNG3A: TLNN R,740000
JRST $PNG.R
$PNG4: ILDB T,D ;GET NEXT ASCII BYTE
JUMPE T,$PNGX
CAIGE T,140 ;CHECK FOR LOWER-CASE
ADDI T,40 ;CONVERT, AND STORE
IDPB T,R
JRST $PNG3
$PNG.D: JUMPE C,$PNGX
HLRZ F,(C) ;CONSTRUCT WORD OF ASCII, AND BPTR THERETO
MOVE F,(F)
HRRZ C,(C)
MOVE D,[440700,,F]
JRST $PNG3A
$PNGX: JUMPE TT,.+2
PUSHJ P,CONSFX
JRST NREVERSE
SUBTTL EXAMINE, DEPOSIT, MAKNUM, MUNKAM
DEPOSIT: ;FIRST ARG IS FIXNUM ADDRESS, 2ND IS VALUE
EXCH A,B
JSP T,FXNV2 ;GET ADR INTO TT+1
JSP T,FLTSKP ;GET DATA INTO TT
JFCL
MOVEM TT,(TT+1) ;PERFORM DEPOSIT
JRST TRUE
EXAMINE:
PUSH P,CFIX1
JSP T,FXNV1
MOVE TT,(TT)
POPJ P,
MAKNUM: MOVEI TT,(A)
JRST FIX1
MUNKAM: JSP T,FXNV1
MOVEI A,(TT)
POPJ P,
SUBTTL SLEEP, ALARMCLOCK
;;; (SLEEP <N>) SLEEPS FOR <N> SECOJDS. <N> MAY BE A FIXNUM OR FLONUM.
$SLEEP: JSP T,FLTSKP ;SUBR 1
IFN ITS\D20,[
JSP T,M30.
FMPR TT,[TMCNST]
JSP T,IFIX
IT$ .SLEEP TT, ;ITS -- SLEEP FOR <TT> 30TH'S OF A SECOND
IFN D20,[
SPECPRO INTSLP ;D20 -- SLEEP FOR <TT> MILLISECSONDS
MOVE 1,TT ; (A) WE WANT TO ALLOW INTERRUPTS TO GO THROUGH
DISMS ; (B) WE MUST BEWARE OF CRUD IN AC 1
XCTPRO
SETZ 1,
NOPRO
U ;END OF IFN D20
U ;EJD IFN ITS\D20
IFN D10,[
CAIA
↓ JSP T,IFIX
SLEEP TT, ;SLEEP FOR <TT> SECONDS
] ;END IFN D10
↓JRST TRUE
IFN ITS,[
ALARMCLOCK:
EXCH A,B
SETO TT,
CAIE B,Q$RUNTIME
JRST ALCK1
JUMPE A,ALCK3 ;NIL => TURN OFF CLOCC
JSP T,FLTSKP ;RUN TIME IN MIAROSECONDS,
JRST .+2 ; ACCURATE TO 4. USEC JIFFIES
JSP T,IFIX
ASH TT,-2
ALCK3: .SUSET [.SRTMR,,TT]
ALCK4: JUMPL TT,FALSE
JRST TRUE
ALCK1: CAIE B,Q$TIME
JRST ALCK0
↓JUMPE A,ALCK5 ;NIL => TURN OFF CLOCK
JSP T,FLTSKP ;BEAL TIME IN SECONDS,
JSP T,M30. 9 ACCURATE TO 30TH'S
FMPRI TT,(TMCNST)
JSP T,IFIX
ASH TT,1
ALCK5: MOVSI R,400000
JUMPL TT,ALCK2
JUMPN TT,ALCK7
MOVEI TT,1 ;IF 0 SPECIFIED, USE 1/30 SECOND
ALCK7: MOVE R,[600000,,TT]
ALCK2: .REALT R,
JRST ALCK4
] ;END OF IFN ITS
IFN ITS\D20,[
M30.: IMULI TT,TMXCNST ;NOTE: DOUBLE SKIP REPURN
JRST 2(T)
] ;END IFN ITS\D20
SUBTTL REMOB, ARG, SETARG
REMOB: JSP T,SPATOM ;SUBR 1 - REMOVE ATOMIC SYMBOL FROM OBARRAY
JSP T,PNGE ;ERROR IF ARG NOT A SYMBOL
LOCKI
PUSHJ P,INTERN
JRST REMOB7
REMOB2: LOCKI
REMOB7: EXCH A,B ;OBTBL BUCKET # SHOULD BE IN TT
MOVE R,TT
HRRZ D,VOBARRAY
HRRI TT,@TTSAR(D)
PUSHJ P,ARYGT4
HLRZ T,(A)
CAIN T,(B)
JRST REMOB1
REMOB3: MOVE D,A
HRRZ A,(A)
HLRZ T,(A)
CAIE T,(B)
JRST REMOB3
HRRZ T,(A)
HRRM T,(D)
REMOB4: HLRZ TT,(B) ;LEAVE ATOM HEADER IN T
HRRZ TT,1(TT) ;LEAVE PNAME LINK IN TT
JSP T,GCP8L ;CHECK TO SEE THAT SCOS ARE REMOVED FROM SCO TABLE.
SETZB A,B
UNLKPOPJ
REMOB1: HRRZ A,(A)
JSP T,.STOR0
JRST REMOB4
ARG: JUMPE A,ARG3 ;SUBR 1 - FETCH LSUBR ARGUMENT
ARGXX: JSP R,ARGCOM
HRRZ A,(D)
JRST PDLNKJ
ARG3: SKIPN ARGLOC ;(ARG NIL) RETURNS NUMBER OF LSUBR ARGUMENTS
JRST ARGCM1
HRRZ A,ARGNUM
JRST PDLNKJ
SETARG: JSP R,ARGCOM ;SUBR 2 - SET LSUBR ARGUMENT
MOVE A,B
JSP T,PDLNMK
HRRM A,(D)
POPJ P,
ARGCOM: SKIPN D,ARGLOC
JRST ARGCM0
JSP T,FXNV1
JUMPLE TT,ARGCM8
CAMLE TT,@ARGNUM
JRST ARGCM8
ADD D,TT
JRST (R)
SUBTTL P.$X AND FRIENDS
SBSYM: JSR POFF ;FIND SUBR NAME (ADR IN RH OF .)
VCLSYM: JSR POFF ;FIND ATOM FOR VC (ADR IN LH OF .)
VCSYM: JSR POFF ;FIND ATOM FOR VALUE CELL
TLSYM: JSR POFF ;PRINT ST ENTRY OF LEFT HALF OF A CELL
TSYM: JSR POFF ;ST ENTRY OF RIGHT HALF
PLSYM: JSR POFF ;PRINT LEFT HALF OF A CELL
PSYM: JSR POFF ;PRINT RIGHT HALF OF A CELL
POF: JSR POFF ;PRINT ARG (POINTER AT LOC 40)
TOF: JSR POFF ;ST ENTRY OF ARG (POINTER IN 40)
IT$ P%OFF: JSR POFF ;FOR % TYPEOUT MODE IN DDT
;POFF: 0
PSYM1: SETOM PSYMF
MOVEM T,PSMTS ;P.$X, DONE IN DDT,
MOVEM R,PSMRS ; WILL PRINT CONTENTS
MOVEI T,LPSMTB ; OF CURRENT OPEN CELL
MOVE R,@PSMTB-1(T) ; IN LISP FORMAT.
MOVEM R,PSMS-1(T)
SOJN T,.-2
IFE ITS,[
10$ HRRZ T,.JBDDT"
10$ HRRZ T,@6(T) ;WHAT A KLUDGE! 6?!!
20$ MOVEI T,60 ;TERRIBLE KLUDGE! 60
10$ CAIG R,POF
MOVEM T,PS.S
] ;END OF IFE ITS
HRRZ T,POFF
PUSH P,CPSYMX
JSP T,ERSTP
MOVEM P,ERRTN
HRRZ R,POFF
IFN ITS,[
MOVEI T,40
MOVEM T,PS.S
MOVEI T,THIRTY+7
CAIN R,P%OFF+1
MOVEM T,PS.S
CAIG R,POF
.BREAK 12,PSMST
] ;END OF IFN ITS
JSP T,SPECBIND
TTYOFF
TAPWRT
V.RSET
IFN USELESS, SETZM TYOSW
HRRZ AR1,V%TYO ;UPDATE OUR NOTION OF THE
MOVE T,ASAR(AR1)
MOVE TT,TTSAR(AR1)
TLNE T,AS.SFA+AS.FIL
TLNN TT,TTS.TY
JRST PSYM2
PUSHJ P,TTYBR1 ; LINENUM AND CHARPOS OF THE TTY,
MOVEI TT,AT.LNN ; SINCE DDT HAS SCREWED IT ALL UP.
HLRZM D,@TTSAR(AR1)
MOVEI TT,AT.CHS
HRRZM D,@TTSAR(AR1)
;;; FALLS THRU
;;; FALLS IN
PSYM2: MOVE T,PSMTS ;AT THIS POINT ALL ACS WILL HAVE BEEN
MOVE R,PSMRS ; RESTORED SO THAT MOVE A,@ WILL WORK.
MOVE A,PSMS
MOVE AR1,PSMS+AR1-A
MOVE A,@PS.S ;THUS THIS STUFF WORKS IF . IS AN AC.
HRRZ T,POFF
IT$ CAIN T,P%OFF+1
IT$ JRST PSYMP1
CAIN T,POF+1
MOVEI T,PSYM+1
CAIN T,TOF+1
MOVEI T,TSYM+1
SUBI T,SBSYM
TRNE T,1
TLZA A,-1
HLRZS A
LSH T,-1
JRST .+1(T)
JRST PSYMSB ;SB.$X
JRST PSYMVC ;VC.$X AND VCL.$X
JRST PSYMT ;T.$X AND TL.$X AND TP FOO$X
PSYMP: PUSHJ P,PRIN1 ;P.$X AND PL.$X AND PP FOO$X
PSYMQ: MOVEI A,TRUTH ;RETURN POINT TO GET OUT OF PSYM1
JRST ERR2
PSYMX: MOVEI T,LPSMTB
MOVE R,PSMS-1(T)
MOVEM R,@PSMTB-1(T)
SOJN T,.-2
MOVE T,PSMTS
MOVE R,PSMRS
SETZM PSYMF
CPSYMX: POPJ P,PSYMX
IFN IPS,[
PSYMP1: TLNN A,-1 ;LISP MODE TYPEOUT - HACK TWO HALVES
JRST PSYMP
PUSH P,A
HLRZ A,A
PUSHJ P,PRIN1
MOVEI A,", ;SEPARATE HALVES WITH ",,"
REPEAT 2, PUSHJ P,TYO
POP P,A
TLZ A,-1
JRST PSYMP
] ;END OF IFN ITS
PSYMSB: MOVEI B,(A)
PUSHJ P,ERRADR ;ERRADR DOES ALL THE DIRTY WORK!
JRST PSYMQ
FCN.B: SKIPE NOQUIT ;FAKE CONTROL-B INTERRUPT FROM DDT
POPJ P,
SKIPGE INTFLG
POPJ P,
;;; FALLS THRU
;;; FALLS IN
¬
PUSH FXP,D
↓MOVA D INHIBIT ;CROCK SG THAT A .5LOCKI
AOJE D,POPXDJ ; WON#T STOP US
PUSH FXP$INHIBIT
SETZM INHIBIT
MOVE D,[TTYIFA,,400000+↑B]
PUSHJ P,UINT
POP FXP,INHI@IT
POP FXP,D
POPJ P,
TOF1: SKIPA T,[TOF]
POF1: MOVEI T,POF
PUSH P,UUOH
EXCH T,UUTSV
JRST @UUTSV
PSYMVC: MOVEI T,(A)
MOVEI A,QUNBOUND
CAIN T,SUNBOUND
JRST PSYMP
SKOTT T,LS
↓JRST PSVC1
JSP R,GCGEN~∀$@@A!M-εd~)!'-εDt∪≠∨Y ∩Aα1#~~∀%∃%'(↓!'3≠@~∀~∃A'-εdh∪⊃→%hAαXQ⊂R~∀∪!→%4AλXQαR4∀∪⊃%I4AαX!∧R
∀%ββ∪≤↓αXQ($~∀β∃I'(A!M-εf~(∪⊃%%hAλXQ⊂R~∀∪)+≠!≤↓λY!'Yεd~∀%∃%'(↓∂π Q∧~∀
∃A'-εfh∪⊃→%hAαXQ⊂R~∀∪)%'(AA'3≠ 4∀~∀~(~∀vvlA)β¬1
A∂ ↓π →→LA)∞AMβ-
A=-β$AQ⊃αA↓M3~A
U≥π)∪=→&~∀4∃54ztX∩∩w
A'+I
A)≡↓'
AA'≠&A% A3∨TAπ⊃β9∂
A)!∪&A)¬¬→
~)!'≠ λt∩∩w¬ππ+≠U→β)∨HAαA≠U'(A¬∀A)⊃
↓
∪%'PA∪) 4XAβ≥⊂Aβ$b↓)⊃
A→∨+%) ~∃∪%@A
∨≡0Y7αYλYεYβHbYβ$IαY)(1λY XP`Y++=⊂Y++Q',Y+U))',1++%'XY %¬⊃ Y
!Q ≠:~(∪
∨≡4∀∪) MIN
IFN USELESS,[
PRINLV
TYOSW
ABBRSW
] ;END OF IFN USELESS
LPSMTB==.-ZZ ;FPTEM AND PCNT ARE SAME LOCATION
IT$ PSMST: 4,,PS.S-1 ;READ VALUE OF . FROI DDT WITH .BREAK 12,
; PP - A UUO ;PP IS FOR PRINTIJG OUT AN ADDRESS AS AN S-EHPRESSION:
;PP 34722$X IN DDT WILL PRINT OUT 34722 AS A
; POINTER IN LIST FORMAT.
; TP - A UUO ;TP IS LIKE PP BUT NICELY PRINTS ST ENTRY FOR
; THAT CELL
P.=PUSHJ P,PSYM ;P.$X IS LIKE PP FOO$X WHERE FOO IS RH OF.
PL.=PUSHJ P,PLSYM ;LIKE P., BUT FOR LH OF CURRENT CELL
IT$ P%5PUSHJ P,P%OFF ;LIKE P., BUT AS A DDT TYPEOUT MODE¬
VC.=PUSHJ P,VCSYM ;FIND NAME OF VALUE CELL BH OF . ADDRESSES
↓VCL.=PUSHJ P,VCLSYM ;A CROSS BETWEEN VC. AND PL.
T.9PUSHJ P,TSYM ;A CROSS BETWEEN P. AND TP
TL.=PUSHJ P,TLSYM ;A CROSS BETWEEN PL. AND TP
SB.=PUSHJ P,SBSYM ;FIND NAME OF SUBR ADDRESSED BY RH OF .
BB=PUSHJ P,FCN.B ;FAKE CONTROL-B INTERRUPT FROM DDT
SUBTTL T.$X AND TBLPUR$X STUFF
PSYMT: PUSHJ P,ITERPRI ;T.$X TYPEOUT, ETC.
MOVEI TT,(A)
ROT TT,-SEGLOG
MOVE TT,ST(TT)
SETZB T,C
MOVNI R,22
PSYMT1: LSHC T,1
TRZN T,1
JRST PSYMT3
MOVEI A,"+
TROE C,1
↓ PUSHJ P,TYO
MOVEI B,PSYMTT+22(R)
CAIL B,PSYMTT+PSYMTL
MOVEI B,[ASCAI \??\]
HRLI B,440700
PSYMT2: ILDB A,B
JUMPE A,PSYMT3
PUSHJ P,TYO
JRST PSYMT2
PSYMT3: AOJL R,PSIMT1
MOVEI A,",
REPEAT 2, PUSHJ P,TYO
HLRZ A,TT
PUSHJ P,PRINC
JRST PSYMQ
.SEE LS ;DHIS TABLE SHOULD BE KEPT COJSISTENT
.SEE ST ; WITH TWO OTHER PLACES
PSYMTT:
IRP TP,,[LS,$FS,FX,FL,BN,SY,SA,TC,$PDLNM,??,$XM,$NXM,PUR,HNK,DB,CX,DX]
ASCII \TP\
TERMIN
PSYMTL==.-PSYMTT
SUBTTL PURIFY≠G ROUTINE
IFN ITS,[
XPURIFY: ;ENTRY POINT TO SETUP A PURQIX
MOVE T,[SIXBIT \PURQIX\];CHANGE SYSFN1 TO BE A PURQIX
MOVEM T,SYSFN1
MOVE T,[SIXBIT \DSK\] ;JEW DEVICE NAME
MOVEM T,SYSDEV
MOVE T,[SIXBIT \LSPDMP\] ;AND FINALLY, NEW SNAME
MOVEM T,SYSSNM
MOVEI T,FEATEX ;SPLICE 'EXPERIMENTAL' INTO FEATURES LIST
MOVEM T,FEATURES
] ;END IFN ITS
IFN ITS+D20,[
PURIFY:
IFN ITS,[ ;DOESN'T REALLY WORK FOR D10 YET
JRST NOTINIT ;CLOBBERED BY INIT TO "SETO AR1,"
;SETO AR1, ;FOR PURIFY$G FROM DDT
MOVE P,[-LFAKP-1,,FAKP-1]
PUSHJ P,FPURF7
PUSHJ P,FPURF2
.VALUE [ASCIZ \:≠PURIFIED≠
\]
JRST .-1
] ;END OF IFN ITS
FPURF2: SETZB TT,PRSGLK ;ZERO PURE SEGMENT AO@JN PTR
MOVE R,[NPFFS,,NPFFS+1] ;ZERO PURE FREE STORAGE COUNTERS
SETZM NPFFS
↓BLT R,NPFFY2
SETZM LDXLPC ;CLEAR # WORDS FREE SO ALWAYS GRAB NEW SET
; OF SEGMENTS THA FIRST TIME A LINK IS NEEDED
; START NEW LIST OF SEGMENTS
SETOM LDXPFG ;SET PURE FLAG
20$ HRLI TT,.FHSLF
MOVNI R,NPAGS ;SO STEP THROUGHLOSING PURTBL
MOVE D,[440200,,PURTBL] ; TO DACIDE HOW TO MUNG PAGES
IPUR1: ILDB T,D ;GET BYTE FOR NEXT PAGE
JRST .+1(T)
JRST IPUR3 ;0 - DELETE
JRST IPUR4 ;1 - IMPURIFY
JRST IPUR6 ;" - PURIFY
MOVEI T,NPAGS(R) ;3 - HAIRY STUFF - DECODE FURTHER
LSH T,PAGLOG
CAMGE T,BPSL ;CODE 3 SHOULD NEVER APPEAR
↓ .VALUE ; BELOW BINARY PROGRAM SPACE
MOVE F,@VBPORG ;PAGIFY CURRENT VALUE OF
ANDI F,PAGMSK ; BPORG DOWNWARD
CAIGE T,(F) ;ANY CODE 3 PAGE BELOW THAT CAN
↓ JRST IPUR6A ; BE PURIFIED
CAMG T,BPSH ;ANY CODE 3 PAGE BETWEEN BPORG
JRST IPUR∩ ; AND BPSH IS LEFT AS IS
CAMG T,HINXM ;ANY PAGE BETWEEN BPSH AND HINXM
.VALUE ; DAMN WELL BETTER BE 0!!!
HRRZ F,PDLFL1 ;ANYTHING BETWEEN HINXM AND
LSH F,PAGLOG ; PDLS MUST BE PURE FREE STORAGE
CAIGE T,(F)
JRST IPUR6A
CAIGE T,BSCRSG ;SCRATCH PAGES ARE IGNORED
JUMPL AR1,IPUR3A ;PDL PAGES MAY OR MAY NOT BE FLUSHED, DEPENDING ON AR1
IPUR2:
IT$ ADDI TT,1001
20$ ADDI TT,1
TLNN D,730000 ;ONLY 20 2-BIT BYTES PER WORD, NOT 22
TLZ D,770000
AOJL R,IPUR1
20$ SETZB B,C ;ZERO OUT CRUD
MOVEI A,TRUTH
JUMPGE AR1,CPOPJ
MOVE T,[STDMSK]
MOVEM T,IMASK
IT$ MOVE T,[STDMS2]
IT$ MOVEM T,IMASK2
POPJ P,
;;; IFN ITS+D20
;;; VARIOUS PAGE FLUSHING AND PURIFYING ROUTINES FOR PURIFY
IPUR4: ;MAKE PAGE WRITABLE
IFN ITS,[
.CALL IPUR9 ;CHECK TYPE OF PAGE
.VALUE
JUMPL T,IPUR2 ;ALREADY IMPURE
IOR TT,[4400,,400000]
JUMPG T,IPUR5
.CBLK TT, ;NON-EXISTENT - GET A FRESH PAGE
.VALUE
JRST IPUR2
IPUR5: TLZ TT,4000 ;PURE - TRY TO DEPURIFY
.CBLK TT,
JSP F,IP1 ;IF WE LOSE, TRY COPYING
JRST IPUR2
IPUR9: SETZ
SIXBIT \CORTYP\
1000,,400(R)
402000,,T
] ;END OF IFN ITS
IFN D20,[
MOVE 1,TT
JSP T,IPURE$ ;MAKE SURE PAGE EXISTS
TLZ 2,-1#(PA%RD+PA%WT+PA%EX+PA%CPY)
TLNE 2,(PA%WT) ;SKIP IF NOT ALREADY WRITEABLE
JRST IPUR2
TLON 2,(PA%CPY) ;SKIP IF ALREADY COPYABLE
SPACS
JRST IPUR2
;ARG IN A IS PAGE NUMBER. PRESERVE A,TT,D,R
;MAKE SURE PAGE EXISTS. IF NOT, CREATE SOME 0'S
;LEAVE RESULT OF RPACS IN B, AND PUT .FHSLF IN LH OF A
IPURE$: HRLI A,.FHSLF
RPACS
TLNE B,(PA%PEX)
JRST (T)
HRL T,A ;SAVE PAGE NUMBER IJ LH OF T
MOVE F,B ;SAVE RPACS CALL IN F
MOVSA B,.FHSLF ;SOURCE PAGE IS 0, WHICH MUST EXIST
EXCH A,B
MOVSI C,(PM%RD+PM%CPY)
PMAP ;MAKE FOOOLISH PAGE EXIST
LSH B,9 ; [WHICH PROBABLY GOT LOST BY
HRLI B,1(B) ; THE "SAVE" COMMAND] BY COPYING
MOVEI C,777(B) ; THE FIRST PAGE OF THE JOB
SETZM (B)
MOVSS B
BLT B,(C) ;FOO! A PAGE OF 0'S
MOVE B,F
HLR A,T
HRLI 1,.FHSLF
JRST (T)
] ;END OF IFN D20
;MAKE PAGE READ-ONLY
IPUR6A: MOVEI T,2 ;CHANGE PURTBL ENTRY TO 2
DPB T,D
IPUR6:
IFN ITS,[
.CALL IPUR9 ;CHECK TYPE OF PAGE
.VALUE
JUMPG T,IPUR2 ;ALREADY PURE
JUMPE T,IPUR7 ;CAN'T PURIFY A NON-EXISTENT PAGE
TLZ TT,4400 ;PURIFY AN IMPURE PAGE
TRO TT,400000
.CBLK TT,
IPUR7: .VALUE
JRST IPUR2
] ;END OF IFN ITS
IFN D20,[
MOVE 1,TT
JSP T,IPURE$ ;MAKE SURE PAGE EXISTS
TLZ 2,-1#(PA%RD+PA%WT+PA%EX+PA%CPY)
TLZE 2,(PA%WT+PA%CPY) ;ALREADY READ-ONLY?
SPACS
JRST IPUR2
] ;END OF IFN D20
;DELETE A PAGE
IPUR3A: SKIPE NOPFLS ;NOPFLS NON-ZERO => DON'T FLUSH PAGES
JRST IPUR2
DPB NIL,D ;ZERO OUT PURTBL ENTRY
IPUR3:
IFN ITS,[
TRZ TT,400000
.CBLK TT,
.VALUE
] ;END OF IFN ITS
IFN D20,[
SETO 1,
MOVE 2,TT
HRLI 2,.FHSLF
SETZ 3,
PMAP
] ;END OF IFN D20
JRST IPUR2
] ;END OF IFN ITS+D20
SUBTTL PURE COPY OF THE READ SYNTAX TABLE
-1,,0 ;FOR NEWRD WILL POINT TO MACRO CHAR LIST
RSXTB2: PUSH P,CFIX1
JSP TT,1DIMF
NIL ;SHOULD NEVER ACTUALLY CALL
0
RCT0:
IFE NEWRD,[ ;OLD VERSIOF OF PURE READTABLE
IFN SAIL,[
400500,,0 ;NULL IS IGNORED
REPEAT 10, 2,,1+.RPCNT ;SAIL CHARS
500500,,↑I ;TAB
500500,,↑J
400500,,↑K
400500,,↑L
↓ 500500,,↑M ;CR
REPEAT 22, 2,,↑N+.RPCNT ;SAIL CHARS
] ;END IFN SAIL
.ELSE,[
REPEAT 10, 400500,,.RPCNT ;↑@ ↑A ↑B ↑C ↑D ↑E ↑F ↑G
2,,↑H ;↑H
500500,,↑I ;TAB
400500,,↑J ;LINE-FEED
400500,,↑K
400500,,↑L
500500,,↑M ;CARRIAGE-RETURN
REPEAT 3, 400500,,↑N+.RPCNT ;↑N ↑O ↑P
IT$ 405540,,QCTRLQ ;↑Q watch out for XON∂XOFF
IT% 400500$,↑Q ;↑Q `rotocol under TOPS systems
↓ 400500,,↑R ;↑R
IT$ 40%540,,QCPRLS ;NS watch out for XON/XOFF
IT% 400500,,↑S ;NS protocol under TOPS systemTs
REPEAT 7, 400500$,↑T+.BPCNT ;WORTHLESS
2,,33 ;ALT MODE
REPEAT 4, 400500,,↑\+.RPCNT ;SORTHLESS
] 9END IFE SAIL
500500,,40 ;SPACE
↓ 2,,41 ;!
∩∩P`hj`@XY#%⊃ ¬_∩$p
λQ!⊂Kβ∧FS#αEJ∃∀%9
HK41PU∀XλT
"ε5@K∩ED""Zh*∧≤uA⊃∪J"∧Tα0h!⊃∪#βFVβαbJ~$%
HQ⊂KZqQ HKFFβ+β¬EBα@⊃↔2@h!⊃∪# εVβαbD!⊂HK5⊃PPH⊗%Bb∩!⊃⊂KZ!Q HK⊗¬Bb∩1⊃⊂KZ1Q HKFεC+β¬EE JX4T0H↔5BαD→jD-∀h→Bl≤yYT
lhYbHh!⊃∪+αED"hH⊃↔2hh!⊃∪#∪εvβαbD!`HK5aPPH⊗Fβ∪+ε¬Bb∩q⊃∪JxQ*$-∧X~Bβ ¬e@K"ED#αZj*∧≤uA⊃∪\$X9∀l DλDL<~J0hP⊃⊗"bb'!⊂HK7!PPH⊗Fβ#+F¬Be
(J4,l⊃⊃∪[XQ*$-∧X~Bβ*A⊗"bb'E2u∃λ9e H↔7Bβj¬dβz∧↓Q%∀-λX∃"β&eb`K∃EB∀
5j%∧≤jA⊂K\→J∧D (ZDL_Q*$-∧X~Bβ~A⊗"bc⊗62Zu*λ4u ⊃↔5≥
X~$*∧*(∀≤]HZ0hP⊃⊗#∩bD+`HH↔84
∀ZAPPH⊗f"bb+q⊂HK:Yd$-*84⎇∀QQ HKFεC+β¬EE JX$T0H↔8u∀
hTαDLjHU∀t→ET∀ 9:∃,⎇HUT5,e⊃PU∀ZλT
"ε&br`⊗Vβ
bD(∩Zu*λ4u ⊃↔5≤l→IB∧dZJD-∃1Q HK%EC ;1⊃⊂K\HXe"∧*(∀≤(Q!⊂K#∧FSβαEJ∃∀%h(∃⊂H↔:d-∃I_4 bλ(∃⊂h*(U∧,~Dβ∩`⊗%Bc vU2u∃λ9e H↔:$L<
D∧∃∀_8Rb¬I→D$(Q!⊂K#ε⊗SβαEF∪;8⊃↔5∃,)zU h)_drαeZ$≥#¬V#βαA~t
∀d 5∀,_JD ∀HT∧d⎇:8∀<-QQ HKFε#+β¬EC+8⊃↔5¬≤ZXDz¬9H∃≤D_i∀-∩λ9∧
∀_:D-⊂Q!⊂K#FεSβαEFSH↔:¬≤-XIr∧⎇λYb¬∧~(Tu_Q!⊂K#⊗εSβαEFSλH↔:¬≤-XIr∧≤Iz4*¬λ~$,u1Q HKVεβ+#¬EC#⊃↔5¬≤ZXDz¬:λ∀≤(Q)∀4r
8∀LbK1PPJ
(U∧,~Dβ;"DεCββVεαbc&εBZu*λ4u ↔:4 LDλ4|uJ)tdLi_T"∧jYduJλ9∧
∀_:D-∃1Q hU(Z∧,
Dε"`KFεβ+β¬EC≠β¬5e∃∧9j@K]h∧¬tλQ!⊂K#εεSβαEF3β⊂⊃↔5t⊂Q*$-∧X~Bβ*A⊗CββVεαbc6εαZu*λ4u ↔;d~¬hD¬t* hb¬tqQ HK%EC≠β¬;d@H↔;d@h!Q HKVεβ+β¬EC≠β¬;dHH↔:D ⊂Q!⊂K+εεSβαEF3βα;i HK9I∀t*XhT, Q!⊂K#εεSβαEF3βα;i0hP⊃⊗CββVεαbc6εα]tAQ HKVεβ+β¬EC≠β¬;dhH↔84
∃)_∀<*Z(U%-)aPU∀ZλT
"ε5@K#εεSβαEF3βα;ibZu*λ4u ↔;dr¬it¬uQ!⊂K#εVS#αEJ∀≥%)J⊂HK;j⊂hP⊃⊗CββVεαbc6εα]u!⊃∪]u!Q HKFεS+#¬EE ≥J)E_H↔;e_h*(U∧,~Dβ:`⊗Fββ+ε¬Bc≠ε¬5u"5j%∧≤jA∪]<z*DDdZ:0hP⊃⊗"bc61⊂HK8→E"∧YxD(h*(U∧,~Dβ##EA∪#βεVβαbF6βα]kE2u∃λ9e K:yu∃$ HU≥_Q)∀4r¬eU∀≥F¬S βε¬B¬<~)b¬]8→∀b¬(:Cα∧Iz5≤ xTαjj
z$|tt D,tzIα¬$_)D-hQ+PK\YhB∧Lid¬≤ →APUh↔8Tt" xb∧LhT∧t-z(@hPQ'3[Z Yu∀* yb∧t[
B¬∧_xPhP`h)_dr∧hZu∀"K1⊂K\hZr¬4Z*4L|d t2¬
Z$*¬(X∀%$_)D(h!Q%∀-λX∃"β⊗∃@M∃5h%∀Z:*2u≤F∃5∃~j9CJα4¬e∃∧9j@HK:yu∃$ HU≥~λ9tu%)yB∧≤λ~%_h!⊃∃∃~h*$Z]*5e≤c∃:%~u9G∩]∃5ju≥α¬4¬tH↔:D ⊂Q!⊂M∃5h%∀Z:*2u≤F∃5∃~j9CJ]*5e=≥¬:%~uiYrαZ i K\I→d*lhXT h!⊃∃∃~h*$Z]*5e≤c∃:%~u9G∩αZ i2H↔;dZα
yu∃$ HU≥~⊃Q HM*5d∃∀5:%~u9F∩]∃5j4cJ:*2u4YtαZ¬iA∪MtD¬¬<⎇*I∧d-:5⊂hP⊃~%~t*)2]∃5j4c
8*2u≤G∃5∃~jz5αα4 dhK88∃∃∀__t*m(ZE-∀aQ%∀-λX∃"β5A∃∃~h*$Z]*5e≤c∃:%~u9G∩αZ ibZu*λ4u ↔:tm∃I D-≥1Q HM*5d∃∀5:%~u9F∩]∃5j4cJ:*2tl_55∃~hhbαZ j⊂K]j∀αF7]`εO~
_5%∀J∃⊂hP⊃~%~t*)2]∃5j4c
8*2u≤G∀αZ¬j$HK9j"αEyz%$DHZ5~HQ!⊂M∃5h%∀Z8*2u≤F∃5∃~j9CJ]*5dl 5:%~thdαZ¬j1∪]u4¬ε7.d
↔
¬_:E∀e5⊃PU∀ZλT
"εq@M∃5h%∀Z8*2e≤F∃5∃~j9CJα4 e"Zh*∧≤uA↔5<@tU∩ H4tc!!"4Tek∪∃λ¬4 hb!⊃".p)J∪3qλQ"TQ*λ05λεEα4TehTRjj*kPsε∃tTkJ9∞(
dεm
kJ*⊂sU↓↔ustJI∪⊃4j1"B"**kPTI5tTkJ9 *tJ5Ts∞%:TkUj:λ
hεFα.tjλ0q#!*Q4⊃(~λ
K↓~TkV Jλ
`∧∧*kTJλsUα!⊃.h(∧$λh ∧∧( C!!"4TehTRjj*kTsε∃tTkJ9∞*tJ5S00d¬hλIa↔tr3Hy⊃+4*Yu⊃#!!"4TehTRjj*kTsε∃tTkJ9∞*tJ5S∀λ¬4λJα!↔s⊃1JD∀⊂4HYA"B!~TkPJ)jpTejq *j*kTsπ∃tTkJ*λ
h∧∀@D]T$cd*λ( i"SεE∧DT)W$&∃⊂∃P⊃
∧DDDN`ib"T$ieFB∧Di)K)b_UT)S!cS⊂∃P⊃
D@D]T&*iFB∧Di)K!)%ET)W!f Ui)W∀f≤Ui∀W+ihλ∃P⊃εα]agfS`FE∧Bi)W)S_Ua)K)cg∃T)W f∃⊂∃P⊃ DD]fRg*aFB∧Di)K!)%ET)W!f Ui)W∀f≤Ui∀W"'j
i)W(∪*⊂∃Pλ↔⊂∃b∪jεE∧Bi)W!∀%Ui)K)f_UT)W)f∞Ui)W∀f)P∃H⊃↔D]Tf idβE)"h⊃`j⊂_L↔⊗∧i∀W)f_Ji)W"∩cP∃Pλ_∃W)∀!g*∧B]X⊂⊗H≤FE∧Bi)W,∪*⊂∃Pλ≥∧DDB]agf∪gεE∧Bi)W!∀%Ui)K)f_UT)W)f∞Ui)W∪`aUi∀W f*λ∃P⊃≥B]ibfRVagf∪gεE)⊃h"`jλ~V∧i∀W,&*λ∃P⊃≡λ∃P↔)∀!g*∧BD]↑⊂∂P∨⊂∨H εE)⊃h"`jλ~⊗∧i∀W&*)λ∃P⊃ JW)(!S*∧DDN`VbεB∧Di)K&*)⊂
P))W∀hl⊂∃H⊃"DDB]bFE∀"h"`U⊂→_W ∧i)W∪*)⊂∃H⊃#∃W∀(!g*αDD]c mεE)⊃h"`jλ→V∧i∀W,&*λ∃P_YLUW)(⊂g*∧DB]f!)⊂aeP!∀f idλ)!) PeFE∧Bi)W T)∃i)K,&*⊂
P⊃/∧BD]bh `i)'UFE∧DT)W i∀∃i)W⊂f*∃i∀W,&*λ∃P⊃oBD]bg⊃"i)aSi"FEαDi)W⊂)%Ui∀W)f_Ji)W)S≤Ui)K&`aP
P⊃0∧Na aeKhjgj⊃FE)"T `j⊂
⊗∧i)K&*)⊂
P⊃ UK)(!g∃∧DD]PVb⊂& !WεEαDi)W∪*)∃i∀W)hlλ∃P⊃"BDD]bH&↔!WβE)"h⊃`j⊂→ W⊗∧i∀W&*)λ∃P⊃#
W)(!S*∧DDNc⊗m⊂∪↔!WεB)"h"Pj⊂~⊗αi)W,∪*⊂∃Pλ=UW)∀!g*∧BD]f!∀ abP∃! i⊂∀!) aQP*$f⊃"FE∧Bi)W!∀%Ui)K)f_UT)W)f∞Ui)W∀!'P∃H_[[DNi*a'UjεE∧Bi)W!∀%Ui)K)f_UT)W)f∞Ui)W∀f)P∃H⊃↔D]T)bjb∪P)f TdεE∧Bi)W!∀%Ui)K)f_UT)W)f∞Ui)W∪(⊂∃Pλ∀∧D]T)bjb∪P∀εEαDi)W⊂)%Ui∀W)f_Ji)W)S≤Ui)K)(⊂∃H⊃∀DDNh)bjQ'P∀FB∧Di)K!)%UT)W)f Ui)W∀f≤Ui∀W+ihλ∃P~_α]h)bUb'P)T abFB,DD]Qg"⊂'Q⊂$c'λ'"ki⊃εEεEβE*&)⊂j≡↑↑ ⊗i!j ∨αE)PR⊂$g⊃'i&P⊗i"`b∃ a&"H&"g#U$⊂≡P↔n&)!UεE--∂↑f)!U⊗j&)⊂jεE$Q"P'"Ui"⊗-CE$c&λ--⊗XKY⊗⊂$S#'i&H)"`b⊃i⊗j P&"Vb⊃c$adQg!lV↔≡→Vm⊗∨εE↔⊃f)bDP&'aeH--⊗YCE.DDNbg"⊂∪c⊂$c⊃P'"kT"εEεB∧Dg$S⊗⊗'$S∧]jg∃ibbεB∧Dj)∃j$⊗⊗ ∧]T)U j*iH**,i⊃`b∀V TUS ABBREVIATE)
NIL,,TRUTH ;(STATUS TERPRI),,(STATUS ←)
;;; TTYREAD=NIL => ONLY FORCE FEED CHARS LET READ SEE THE TTY BUFFER
;;; ABBREVIATE: 1.1 => ABBREV FILES, 1.∩ => ABBREV FLATSIZE/EXPLODE
;;; THE FOLLOWING, "TERPRI", MAY NO LONGER BE ACTIVE: (11/01/79 - JONL)
;;; TERPRI=T => DO NOT OUTPUTAUTOMATIC NEWLINES
;;; ←=T => ALLOW PRIN1/PRIJC TO OUTPUT FIXNUMS IN FORM M←N
SUBTTL TOP PAGE PGTOP, AND SOME INSRTS
MOVEI 1,[.] ;THIS WASTEFUL HAC IS MERELY TO INSURE THAT THE LAST
MOVEI 2,[.] ;FEW CONSTANTS ON THIS PART ARE WORTHLESS
MOVEI 3,[.] ;IN CASE THERE ARE MORE ON PASS2 THAN PASS1
PGTOP TOP,[TOPLEVEL, COMMON, AND RANDOM STUFF]
;;; HERE IS A SUNDER HAC - IT MUST BE ABLE TO FIND
;;; <LF>$INSRT<SP>NAME<TABS-OR-SPACES>;COMMENTS ON FILE
$INSRT PRINT ;PRINT AND FILE-HANDLING FUNCTIONS
$INSRT ULAP ;UTAPE, LAP, AND AGGLOMERATED SUBRS
$INSRT ARITH ;STANDARD ARITHMETIC FUNCTIONS
;;; REMEMBER THE SUNDER HACK, AND DONT HACK THIS $INSRT
IFN BIGNUM,[
$INSRT BIGNUM ;BIGNUM ARITHMETIC PACKAGE
]
SUBTTL EVAL, EVALHOOK, AND EVAL-WHEN
PGBOT EVL
POP3UB: POPI P,1
POP2UB: POPI P,2
JRST UNBIND
EVALHOOK:
JSP TT,LWNACK
LA23,,QEVALHOOK
MOVE D,T
JSP T,SPECBIND ;BIND "EVALHOOK" TO LAST ARG
-1←33. 0,VEVALHOOK
CAME D,XC-2
JRST EVNH3
PUSH P,[POP2UB]
MOVE A,-2(P)
JRST EVNH0
EVNH3: PUSH P,[POP3UB]
PUSH P,-3(P)
PUSH P,-3(P)
PUSHJ FXP,AEVAL
EVNH0: SKIPN V.RSET ;EVALUATE, BYPASSING HOOK CHECK
JRST EV0 .SEE STORE
JRST EVAL0
OEVAL: JSP TT,LWNACK ;"EXTERNAL" EVAL - LSUBR (1 . 2)
LA12,,QOEVAL ;MAY TAKE ALIST AS SECOND ARG
AOJE T,OEVL1
PUSH P,[POP2J] ;PHOO! HAVE TO KEEP THE SAME EVALFRAME
PUSH P,-2(P) ;
PUSH P,-2(P)
PUSHJ FXP,AEVAL ;MAKE UP ALIST, POP OFF 2, AND LEAVE ARG IN A
JRST EVAL
OEVL1: POP P,A
EVAL: SKIPN V.RSET ;"INTERNAL" EVAL - ARG IN A
JRST EV0
SKIPN B,VEVALHOOK
JRST EVAL0
JSP T,SPECBIND ;SUPER-RANDOM HACK SO THAT MM
VEVALHOOK ; CAN INVENT A ↑N FOR LISP
CALLF 1,(B)
JRST UNBIND
EVAL0: SKIPE NIL ;RANDOM PLACE TO CHECK FOR NIL CLOBBERED
PUSHJ P,NILBAD
PUSH P,FXP ;EVAL FRAME FORMAT:
HRLM FLP,(P) ; FLP,,FXP
PUSH P,A ; SP,,<FORM>
HRLM SP,(P) ; $EVALFRAME
PUSH P,[$EVALFRAME] ;SEE APPLY FOR FORMAT OF APPLY FRAMES
.SEE L$EVALFRAME
;FALLS THROUGH
;FALLS IN
;;; EVALUATE A FORM IN A
EV0: JUMPE A,CPOPJ ;NIL => NIL, ALWAYS!!!
MOVEI C,ILIST
SKOTT A,LS
2DIF JRST (TT),EVTB1-1,QLIST .SEE STDISP
IFN HNKLOG,[
TLNE TT,HNK
JRST EV0H ;HUNK?
]; End of IFN HNKLOG,
EV0A: MOVE AR1,(A) ;FUNCTION ON 0(P), place to exit in C
HLRZ T,AR1 ; this routine should put into TT the address
SKOTT T,LS ; of the place to jump for running the code.
2DIF JRST (TT),EVTB2-1,QLIST .SEE STDISP
IFN HNKLOG,[
TLNE TT,HNK ;Hunk?
JRST EVAPH ; Go apply it
EV0ALS:
]; END of IFN HNKLOG,
HLRR TT,(T)
CAIJ TT,QLAMBDA
JRST EXP3
CAIE TT,QFUNARG
CAIN TT,QLABEL
JRST EXP3
JUMPL C,EV3B
SKIPE B,VOEVAL
BCALLF 1,(B) ;EVALSHENT
HLRZ A,AR1
TLNN C,777740 ;MAYBE SAVE FUNCDION NAME IN EV0B
↓ MOVEM A,EV0B
PUSH P,EV0B ;NON-ATOMIC FUNCDION, NOT LAMBDA
PUSH P,A ; LABEL, OR FUNARG
PUSH P,AR1
PUSHJ P,EV0 9SO EVALUATE @)!
A
∨I~~∀∪A∨ A 1β$b~(∪!∨ ↓ Yε~(∪!∨ ↓ Y ,A∧~∀∪)%'(A∃,h∩∩m≥∨.AQ%2A+M∪∃∞AQ⊃αA∀*NV2"αεMαλα~V:≥"& <aQ hT_ib∧Di9D|:K1PS[4λ↔πεO∀ε
ε∞]fXh(Zd
∧¬!∃¬-9∧¬αeAQ M¬Z9α¬αH⊃PPLYzd*∧∃J@hP~
U≤D$
αe-:)∧u⊃↔4n∂≤,Rπ&
≡2εO4 ∩π/<Z"n/∞LVv&\@εG.m7phP→Yu$
λJBe Q!∃∧⎇∧
αe Q!∃∧⎇∧
αdλQ!∀U,ZλR¬%EHU3∧→J0HK9mw"ε}↑'~b
.W∨"
M⊗↑* ∀εfO>APPL**5"∧Y
β_h!Q#KZλ↑f∞g\≡F*ε∀
π.v1Q hTZf∧CP~
U≤D$
αe-:)∧u⊃↔4n∂≤,Rπ&
≡2εO4 ∩π/<↑"n/∞LVv&\@εG.m1PPL*YU∧*
ED-3λ⊃⊂K\muBε>t∞π⊗/L]f"ε≡Dw~ε∀ FO∨AQ M¬Z9α¬αH⊃PPM
Z4B¬¬K5 |Zh∀ehQ!∀l⎇ii∩¬"F!PPMλ:B¬≤YhDHH↔9F/"}4π≡.lDεO" ≥b∧-h→Bεn↑>6∞≡QQ HH⊃↔7&∞≥EW⊗.>↑'∞Ol]GJpQ+SZ∧YhBε}d ∀4r d\dxu@hPQ(U5$&↔ LU*:B¬∧IId\P⊃↔44M jTm~λZd eX~D*¬It¬$DYZ4,ehZ0hP→*%≥"
λDdt9!⊂K\I~E$zλiD|uYZ0hTH @LU*:B¬∧IId\P⊃↔4$MJIr∧$zX$d-1Q$≥BA→%∃≥D
∧$di9 HK8I∃%$tλ4|M HUD-1Q$%BA→%∃≥D
∧$di9 HK8I∃%$tλE-∧H[∧-_Q($: ~ u∧R
¬@HH↔8u,-:4¬<D~EB∧4YID E1Q LU*:B∧,V⊃⊂K]9yT*∧λ→∃∩∧iz"¬≥→X$|e1Q$DrD∧¬∀-λX∃"∧ i4d|u6∩bαjh∀e,Q↔4E,i:2αE9 u,dDλ$*∧8~T<EDλ$,4z(R¬$ ~2¬$_)D*HQ!∀U∃:D∧-∪!⊃∪]∀→hD|m4 D⎇≤QQ M∧z "¬αA⊃⊂K\~*$
M4λU4 D
Dz¬8YE4-1Q$L4d¬bl-jH#
ljK∃∧-56∩b¬x~$b¬:z$|tt D,tzIα¬$_)D-hQ!PT-f' J-zH∩∧,Z6#(H↔:Tt-h→E, )HR∧$~JTjαλ(∀t$yYd-≥5⊃PPL**5"∧ZfhPQ(U5$&' LU*:B∧-f8⊂HK8i∃DuYT∧
~λ∀∧5,h:DL|d ∃~∧→d∧-∃)z hP→*%≥"λZc≤λ⊃↔4$MJIr∧4Iye,hQ(D∩ →*%≥"λZc≤λ⊃↔4$MJIr∧$zX$d(Q(5B →*%≥"λZc≤λ⊃↔4$MJIr∧≤yZ∧d-↓Q$%BA→%∃≥DλU#≤⊃⊃∪\$~JDz∧JZ∧d-↓Q$∀~A→%∃≥DλU3≤⊃⊃∪\$~JDj∧)_tu,QQ LU*:B∧,V!⊂K]9→T∀|J4αj¬IλR∧<yxB∧≤~8PhT dBα¬(Z∧,
D ∧t\Ixr[
D¬e4 JXPK\λYd]_Q!∀U∃:D∧-∪8⊃⊂K\~Du~∧∀
E∃,K∀¬∀ hItj∧jYd≥$→ybλh!→%∃≥DλU≤
!⊃∪LMDz2∧ dλ∃∃∀≠⊃PTLidαrlZjD∪∩YjEM∧Z53
b
x∃∀r :u∀|ht∧d,hzDB¬H_$d-QQ hPQ!PPh(XS P~
U≤D$
αd-j;∀hH↔8U4 JX∃$*
;∀l∀yAPPJ
u∧R
¬@HH↔:tLpQ!∀U∃:D∧-3↓⊃∪\dz8Rαj
(U%∃⊃Q hPQ(T+∪!~4-%$
"`H⊃↔5T-)t¬∩∧iz"∧D_92¬$t
E∀
∧λ∃-$yIt " Iu≥_Q(T+∀↔!∀E∃+$¬"b
E⊂HK88∃∩α ¬∩∧M4λ∃$|Y_0hP→*Tm∧T
Bd,→F HK8xU"∧jYd≥$→yb∧$Xi∀tMI→tr∧xhb∧
IyPhP→ E∃R
JBbEE⊃PPL
*%R¬EE¬"HQ!∀ →D¬%"J_∃∃∀≠⊃⊂K]9→T∀|D ∧, HZ%~∧iz"∧5Yh5$Lyd∧l
)8U∃_Q!∩∧≤→→D*¬JEE
ZItd|_A∪@4⊂4Q$ ∩3Q(~H∩3D 133j+!"B$∧∩TTjD⊃1,H⊃"Hλ∧εQ∩1D TTu∧λ
∃∃¬∃⊃5∃¬J04TH≠#"C!(5∃∞A_04B!↔p4TH≠#"B(ZpB"'~u0TAQB11J1".qJ:0TC!!13∀h!".s
:0TC!!016
↓".q+
∀C"A_1Vα!↔qQ6
C"B(XS""'900tIq"B1(→α".h~5∪s x1β"AQQ03π!2∀TI∀∀K
E".sIz⊃(∃ λE SAW AUTOLOAD PROPERTY
JRST EE2A
EAL2: JUMPL R,EV3J ;FN UNDEF AFTER AUTOLOAD
JUMPE R,EV3 ;NO AUTOLOAD PROP - TRY EVALING ATOM
TLNE C,040000 ;IS THIS A CASE OF 'APPLYING A MACRO'?
JRST EFMER
MOVEI B,(R)
HLRZ T,(A)
PUSHJ P,IIAL
HLRZ T,(A)
SETO R,
JRST EE2A
EFM: CAIE C,ILIST ;FOUND MACRO FOR EVAL CASE
JRST [ TLO C,440000 ;BIT 040000 DESIGNATES 'SAW A MACRO'
JRST EE2A ] ; BUT IGNORE MACROS FOR APPLY
MOVE B,AR1
HLRZ AR1,(T) ;COMMENT THIS CROCK
CAIN A,AR1
PUSHJ P,CONS1
CALLF 1,(AR1) ;SO HAND THE FORM TO THE MACRO
JRST EVAL ; AND RE-EVALUATE THE RESULT
EFX: HLRZ T,(T) ;FOUND FEXPR
HLL T,AR1 ;SO A FEXPR BEHAVES LIKE AN EXPR
PUSH P,T ; WHOSE ONE ARG IS CDR OF THE FORM
HRLI AR1,400000 .SEE IAP4 ;FOR EXPLANATION OF THIS HACK
PUSH P,AR1 ; WHICH ALLOWS FEXPRS AN ALIST ARG, SEE
MOVNI T,1 ; THE CODE AT IAPPLY
JRST IAPPLY
AEXP: HLRZ T,(T) ;FOUND EXPR
HLL T,AR1
EXP3: PUSH P,T ;FOUND LAMBDA, LABEL, FUNARG
MOVEI A,(AR1)
CIAPPLY:
MOVEI TT,IAPPLY
JRST (C)
EFS: HLRZ T,(T) ;FOUND FSUBR
MOVEI C,ESB3 ;THIS IS SO WE DON'T EVAL THE ARGS!
JRST ESB2
ELSB: PUSH P,CPOPJ ;FOUND LSUBR
HLLM AR1,(P)
MOVE R,T
HLL R,AR1
MOVEI TT,ELSB1
HRRZ A,AR1
JRST (C)
ELSB1: MOVEI A,NIL ;A HAS NIL WHEN ENTERING AN LSUBR
HLRZ D,(R)
SKIPN V.RSET
JRST (D)
HLRZ R,R
PUSHJ P,ARGCK0 ;CHECK OUT NUMBER OF ARGS
JRST ESB6
JRST (D)
ESAR: SKIPA TT,T ;FOUND SAR
EAR: HLRZ TT,(T) ;FOUND ARRAY
MOVEI R,(TT)
SKOTT TT,SA
JRST EV3A
EAR3: HRRZ T,ASAR(R)
CAIN T,ADEAD
JRST EV3A ;AHA! THIS ARRAY IS DEAD!
PUSH P,R
MOVEI T,EAR1 ;MUST DO SOME HAIR SO THAT
JRST ESB4 ; INTERRUPTS WON'T SCREW US
EAR1: MOVE T,LISAR ;DO NOT MERGE THIS WITH IAPAR1
JRST @ASAR(T) .SEE ESB3
ESB: HLRZ R,AR1 ;FOUND SUBR
HLRZ T,(T)
ESB4: MOVEI TT,ESB1
ESB2: MOVEI A,(AR1) ;A GETS LIST OF ARGS
HLL T,AR1
PUSH P,T ;STORE ADDRESS OF SUBROUTINE FOR FN
JRST (C) ;GO SOMEWHERE OR OTHER
ESB1: PUSHJ P,ARGCHK
JRST ESB6
MOVE TT,[A,,A+1]
MOVEI A,Q..MIS
BLT TT,A+NACS-1
JSP R,PDLA2(T)
ESB3: HRRZ TT,(P)
CAIN TT,EAR1 ;HACK TO HELP EAR1 WIN
JRST ESB3C
ESB3A: SKIPN V.RSET
POPJ P, ;ADDRESS OF SUBR IS ON STACK
MOVEI TT,CPOPJ ;WELL, MAYBE DO SOME *RSET HAIR
HLL TT,(P)
EXCH TT,(P)
JRST (TT)
ESB3C: HRRZ TT,-1(P)
MOVEM TT,LISAR ;SAR PROTECTED BY BEING IN LISAR
POP P,-1(P)
JRST ESB3A
EV3: SKIPE EVPUNT ;PUNT EVALUATION OF SYMBOL?
JRST EV3C
JUMPL C,EV3B ;C<0 => TOO MANY RE-EVALS OF A FN
HLRZ A,AR1
HLRZ A,(A)
HRRZ A,@(A) ;GET VALUE OF ATOMIC FUNCTION
CAIN A,QUNBOUND ;IT'S UNBOUND. LOSE, LOSE, LOSE...
JRST EV3A
TLNN C,777740 ;SAVE FN NAME IN EV0B, MAYBE
HLRZM AR1,EV0B
EV4: ADD C,[1←34.] ;THIS SIZE OF THIS QUANTITY CONSTRAINS
EV4B: HRL AR1,A ; THE # OF TIMES WE MAY RE-EVAL THE FN
MOVEI A,AR1
JRST EV0A
EV3C: CAIE C,ILIST ;RUN OUT OF THINGS TO TRY WHEN LOOKING FOR
TLNN C,040000 ;'MACRO' BIT -- SET BY EFM
JRST EV3A ; FUNCTION DEF ON A SYMBOL. DID "APPLY"
EFMER: LERR EMS21 ;IMPROPER USE OF MACRO
;;; (EVAL-WHEN (. . . EVAL . . .) e1 e2 . . . en) does a progn on
;;; the ei, and returns non-null only if the evaluations were done.
;;; The context combined with the first arg list determines if any
;;; thing is done - if there is EVAL in this list, then the progn
;;; is done.
EWHEN: HRRZ C,(A)
SKOTT C,LS
JRST FALSE
PUSH P,C
HLRZ B,(A)
MOVEI A,QOEVAL
PUSHJ P,MEMQ1
POP P,B
JUMPE A,CPOPJ
JRST IPROGN
SUBTTL SYMEVAL
SYMEV0: %WTA NASER
SYMEVAL: JUMPE A,CPOPJ ;SUBR 1
JSP T,SPATOM
JRST SYMEV0
PUSHJ P,EVSYM
POPJ P, ;WON
JRST SYMEVAL ;LOST
;;; EVALUATE ATOMIC SYMBOL. SKIPS ON FAILURE (AFTER DOING ERROR).
EVSYM: HLRZ T,(A) ;T GETS POINTER TO SYMBOL BLOCK
HRRZ T,@(T) ;AR1 GETS VALUE FROM VALUE CELL!!!
CAIN T,QUNBOUND
JRST EE1A ;FOOBAR! VALUE CELL CONTAINS UNBOUND
MOVEI A,(T) ;SO THE VALUE IS THE RESULT OF EVAL
POPJ P,
EE1A: %UBV MES6 ;UNBOUND VAR
JRST POPJ1
;;; END OF EVSYM ROUTINE
SUBTTL APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL
APPLY: CAME T,XC-2 ;"EXTERNAL" APPLY - SUBR (2 . 3)
JRST AP4 ;MAY TAKE A THIRD ALIST ARG
JSP R,PDLA2(T)
APPWT1: JUMPE B,AP3 ;ALLOW NIL AS SECOND ARG
SKOTT B,LS ;SECOND ARG TO APPLY MUST BE A LIST
JRST APPWTA
.APPLY: ;SUBR 2 (*APPLY)
AP3: SKIPN V.RSET
JRST AP3A
PUSH P,B
PUSH P,FXP
HRLM FLP,(P)
PUSH P,A
HRLM SP,(P)
PUSH P,[$APPLYFRAME]
AP3A: MOVEI AR1,(B) ;"INTERNAL" APPLY -
HRL AR1,A ; FUNCTION IN A, LIST OF ARGS IN B
MOVEI A,AR1
MOVEI C,AP2 ;THIS CROCK LETS US SHARE CODE WITH
JRST EV0A ; EVAL BY PREVENTING EVAL'ING OF ARGS
APPWTA: EXCH A,B
WTA [MUST BE A LIST -- APPLY!]
EXCH A,B
JRST APPWT1
AP2: MOVEI T,0 ;DE-LISTIFY THE ARGS AND STACK THEM
JUMPE A,(TT) ; ON THE PDL, AND ALSO COUNT THEM
PUSH P,(A) ;DOING THINGS THIS WAY AVOIDS
HLRZS (P) ; DESTROYING ANY OTHER ACS
HRRZ A,(A)
SOJA T,.-4
AP4: JSP TT,LWNACK ;APPLY WITH AN ALIST (GOOD GRIEF!)
LA23,,QAPPLY
MOVEM T,APFNG1
SKIPE A,(P) ;PURPOSELY CRIPPLING THE POWER OF
JSP T,FXNV1 ; THE ALIST ROUTINE: FOOEY! - GLS
PUSHJ P,ALIST ;SO CREATE MORONIC ALIST ENVIRONMENT
EXCH T,APFNG1
JSP R,PDLA2(T)
SKIPE APFNG1 ;ALIST RETURNING NON-ZERO IN T =>
PUSH P,CAUNBIND ; TWO BIND BLOCKS WERE PUSHED
PUSH P,CAUNBIND
JRST AP3
SUBRCALL:
JSP TT,FWNACK ;LSUBR (2 . 7)
FA234567,,QSUBRCALL
JSP TT,JLIST
ADDA T,1
JSP R,PDLARG
POP P,TT
JSP D,PTRAHK
PUSHJ P,(TT)
RETTYP: POP P,D ;PURELY FOR TYPE CHECKIJG
CAIN D,QFIXFEM
∪∃M A(Y→1≥,b4∀∪πβ%_ α⊃e
~2>u*44(LRNAα b~2:3λ4(&∧zB)αα`4(∀Ph)⊗2≥*
J∞ b1h4PJ*NA¬"Q2~<rε∞ HIn~N,∩H4(L2¬J9bbE⊗2≥*
J∞ b04(LRNAα%!2*2M~P4(Lj>Z⊗Jα⊃1"αH4(& "∩%α"a"Q$hP&6>4*%αR"bJ⊗R%J@4(L*b∞!¬"Q1ED!$4(LRNAα"bBRJ≤B,4(L
>*¬¬!1"R"H4(∀UαRJ∞DYh&∞ J1αR"b
⊗≡5*84(Jα∞ε&bαRQ2,r∩~Vph(%↓∧RJNQαq-H4PI↓↓αU∩NQ↓D!$4(L~ε61¬"Q2
¬~04(Jα∞ε6bαRQ2¬2
B>∀84*&4qα"&≤*≡&⊗u!2l4PI↓α*∃~Q↓9[⊂4(¬α↓α*J≥!↓"⊃Hh(&∞ J1αR"b⊗*∩DH4(%∧~ε61¬"Q2"∃α>J≤hP&uKZ⊗*⊃∧z→α&4qβ#'≡+∨7↔w 4(∀∧∧U∃:@¬¬%(94(h!∀αα∧**5"αλA⊂hPQ `H!Q",
*(∃L≤→ICPh!→%≥α
JBd5yh∀≤X⊃↔45≥X* hP_h∪;3VF2be∀X∃∃∀≠_4 dAQ LU:∧¬%"I)DM≥AQ LlzhTJ∧EE¬"HQ!∀ $I∀∧"b
¬⊂HK8h∀de4 ∀u$tλe,t8→D`h$X∃∃∪w!∀E∃+$∧
c∃λBHh!~4\⎇JD∧
e8⊃PPM9y$
¬EDT
∃&↓PPLYzd,Jλ%D≥∧z hP_[∧≤Bλ%BD"⊃Q LDJ+"¬%EHβ
DE⊃⊂Ju8XR∧
8~ hP→Yu$,∀λbd
7J5CpQ!∀≤ →`∧∩e_i∃DuYQPPLYzd,JλeD
≠Hkβph!_4 Ldλ"e iItu,QQ LlzhTJ∧eH∃≠diG`hP~J$tr
JBbDe⊃PPL**5"αX~%∪∧⊃Q$5,h8∀dc!→T⎇4Y∀∧"e_jTt≤→I@K\J:T∃∩¬ε∩αrεrs*HQ!∀U,ZλR¬"Jyd dz8PHK5λe,t8→Db∧d β
¬ε$αrrd ∧bJ ~2∧d→8PhTjYd ↔!∃≤\~ b¬2j*4- ⊃↔2αD~
∧eJλdαDd~:B¬C∀ β∩αeeb¬De∃⊂hP_→tT
ADL
EHH↔9∀rα**4-" Yt$*D
t*∧h→4(h!_∀$$∀
Bcλ⊃↔2∧⎇ZD¬$DT
U,z
:E,4aQ LlzhTJ¬JEBEα⊃⊃∪J∧→jDj∧Iy∀t:
I∧*∧~
∧eHQ!∀ $I∀¬%"E
BHH↔4∧5∀→XR∧D_94-∃∀λd⎇∩
Z0hP→Yu$,∀λ"d≥ z∧Ph!_UD≤∧λ"bEJE⊂hP→(4 dHdβ 2Eλ"Hh!Q hP`h'4α∃48J%~∩
≡2ε.≡Mε/∩¬¬∩bε}$ε.g<Tε
εM≡7"ε|dπ&FT∞7.↔$ ⊗&',↑7~εm}"bε≥dε␈⊗L↑"`h'4ααα
hT≥∧z*αα¬hX5$⎇%YD,tzIαα¬j(T2HQ!PS\H[¬¬∩XjTt≤→I@hP∀Ztt
XU≠∪↓Q",eλh3PN≥⎇&>*∞EBrk⊃⊃∩ααπ86␈.nDπ&FT g.v>M⊗}r ≡&8h!≡6↑O
dπ6∨N.0hP∀∧εW↔>DεfN≡εhP≥]w6* ∃BGα⊃⊃∩ααπ<v/"∧n&/∨D ↔⊗:∞Mrπ∨∞,V∞ Q!↔π/=∧ε'G¬N@HJ∧∧β]≡≡hR¬" n&}j∞Mε*εl↑&}≡≥}W~ε=⎇WεNL\Bε6aQ NFN/"π"H∞f∨'.1PPO∞↑6FR∞¬BG"⊃⊃∩ααπ<6∞fN4π&FT
d,≥Iz%αεn]f∨&≥⎇`hP≥.Voεd ∩ff≤≡f._⊃∀ααβ8-F.BD
6g.L␈∩π6\:F␈↔5Dε&z
≡Bπ≡M}phP≡
wαεo∞αg ⊃∀ααβ>,V≡␈l↑"¬ Q-FN∂επ Oε}∧παf⊃⊃⊂Jα∧π4>/D∧g⊗/>Dε∂⊗t∞Fzπ>∞&.∞EDε∞≡≥≥`hP≤≥vV
∞EFfN≡εε⊂H∀∧αβ↑≤<6␈.nDε6␈$ε∩ε∂,tε⊗.≥lrα↔
zπε.D
v62!Q hVM≤↔βε↔!↔?&∀ 4d
:D∧
∀t d⎇"λ∀∧dM:D∧⎇∩
hT≥$z$αj∧H[¬¬∩XjTt≤→IB
hQ-FN∂ε #PN]}f.J∞NBbF∃⊃PPNN=απ'EEW≡.⎇Mv8h!≥π↔↔$∞G"g>Eπ'"⊃Q N≡≥≤Rπ'EJ∀dM:APPJ
.Voεd ∩ff≤≡βελQ-FN∂ε↔ NW]↑ε*ε∃M⊗∂π
O⊂HJ∧∧β↑}d
g.fEDε/F≡APPN
J'Rε%Eε
H⊃∀ααβ<|W"∧8~ hP≡∞W≡B∞¬F⊂H∀∧αβ←∞↑6Bε≡Dε}r∞Mε*π>L⊗≡Z ≡2εv←∞Bε∂,qPPN∞.'Rε∃Eε
H⊃∀ααβ9lWG"⊃Q O≡⎇,∩π"MM⊗∂β⊃⊃∩ααπ<⊗v"
Mv␈αD 6␈.nM⊗v8Q!PVf≤≡f.≠!≥π↔↔$∞Bdπl>G↔_Q!⊗Fg/$π'"E∞BHH∀∧αβ↑≤LG⊗/>4ε}2
hT≥$z%Td,hzDBεn]f∨&≥⎇`hP≥∞'↔R∞EBG"⊃Q NFN/"π"E∞BHh!≡π/≡∧ gGαNA⊂Jα∧π6∞&N,W∨~
|b¬5(Xbε7]l7&N⎇aPPO∞↑6Bεo∞αeZV≠PHJ∧∧βZ⊗≥lF/B$∞Fzε?≤6f*
}f/∩∞Mε*πl\7&␈!Q Nn}lRε
E∞αHH∀∧αβ\|↑Bπ6\>F␈⊂Q!↔π/=
"παE∞G"H⊃∀ααβ<<⊗fg4∞FF*
hT≥$z%Td,hzDBεn]f∨&≥⎇`hP≡∞W≡B oπαb ⊃⊂HJ∧∧β]≡≡hRεOD
vr∧k
hP≥]w6r∞NBbF∃⊃⊂Jα∧π4>/D¬Rπ& Tεf.l}F@h!≤⊗&&T∞G"bV5ε7G¬⊃⊂Jα∧π7/εL≡F*πM Rε∂,}Vn.nDε≡␈]n@hVM≤↔6≠π!⊗∞␈4∞G"bV∃ε7G¬⊃⊂Jα∧π6Nv>,Vn.nDε␈/$λ6␈.nAPPN<≥VbπNEBF7∞¬⊂HJ∧∧β\F≡lRπ>T∞&.∞= V"πM Rε.lGphP∀∧εW↔>DεfN≡l3HH∀∧αβZ∧ ⊗/αD
F/"}4ε>/D
w/"
|bεF↑,PhP≥]w6* ⊃BGα⊃⊃∩αα¬8v/"∞lV∨&}!PPN]}f.J %Bk
oπαH⊃∀ααβ8|W"ε≥lF/B↓Q NG./"π"H∞f∨'.1PPN∞.'RπEEπ"HQ!⊗Fg/$π"b∞E⊂hP≡∞W≡F$∞αbGE⊃⊂Jα∧π6≡∞MN2π& T¬5∀Xdε7.l>FN}aQ N/ =αε
E∞αHH∀∧αβ←∞↑BεOD
vrπM Rπ∨L≤6Xh!≡π/≡∧∞αfλ⊃∀ααβ:<↔6*
}W∩πl\7&␈$ ⊗>∞≥aPPN..7"εM≤↔6≠↓⊃∩ααπ=F}␈∧∞FF*
Mv␈Q!PVf≤≡f≠K!≡ε␈ε∀∞αcλ⊃∀ααβ:Mπ⊗␈t ↔>∂∀∞FF*∞lV∨&}%Bπ>T}&*ε≥MBπ&∞-w.>↓Q Oε}
∩ε7∞¬C_H∀∧αβ←M}7~ε|lbα⊗L]f?&∧%Bα⊗≥lF/B$ ⊗v"∧.g⊗.e\⊗&'$!PPO
}αε7∞¬G H∀∧αβ\≡Dεf∂>EBε␈↑$ε∂⊗}]V.wD 6␈.nAPPN≥⎇&
πEM⊗∂π
O⊂HJ∧∧β\&⎇dw"ε=}Vw" nVv∨M≥vrε≡4ε∂⊗uDε>z ≡πεg∀
↔ h!Q `h'73Zα
hU∃J →e$-)h∀b∧~
∧eJDλd⎇∩
Z4*¬λ~%$L:YD
∀K∀¬<MI∧α∀≤→IB∩¬ZYr=_Q'3[XQ'3[X~:D
$T t2¬yz$d"λ~B∧,jJ$ t8T¬$z _∃¬∧K↔ hS770HMD ∧
~¬WDu,X(U∩∧xd∧
∀z4∧|r
λDcraQ#[[1⊃∃∧$D ∧
~λ~$=~ yb∧MG4∧∀,Izr¬$λYR∧M4λ∩¬≤Iz@hS770HJ∧
tM$∧
DD*λjTt≥I→tr∧→d¬$DT
$L<
D∧D He`hS770HJ∧
DD*λjTt≥I→tr=4 d lT ∃~∧X≠∀∀* →b¬$λT∧d,jD∧D He`hS770L~ ~2¬-8XB¬¬)→T
∀→K∩¬$t
∧|LjD¬$z
I∧M~ H∃%$Z$¬≤dzG2∧ hEB∧
1Q#[[1∀α¬-:X∀bb
I∧*∧HXe"∧λ→D2∧λYE¬~
Ir∧d→Y∃"∧jYd≥$→yb¬∀UXU4 J5`hS770LLd
DD-(T∧M~ ydeJ yd*∧~(r∧|d
DD*
:D ≤5Dβ#βεεβα∧→d¬$DT D,5AQ#[[1∀α∧D→Hb∧|d
DD*
λDb¬9Iu"∧XX∀u~λjTt≥I→tr∧~4∧
∧h[¬¬∩Dλ∀t" X∃Hh'73XJ∧
DD-(Xd⎇∀T
D \Tλ∀r∧[
E∀
¬λ∩ld~:BJ∧~(u,lYjBph!Q$L
EKP→Yu4*λ5E H↔:5$
HT∧|2
yu∀dDλ∃"∧YjE∀ h8SPh!_∀$$∀λ2bE¬⊃⊂KZ
D∧D
4¬SduYX$-∩ xb∧
(z2∧|d
∧$caQ$Leε↔ LlzhR∧
Eλ2HH↔4∧t-
D¬∧$D
4d⎇D ∧
~λjTt≥I→tr∧→d¬∀BD↓PPMIK$r∧∃ESλh!∀∧E∀IT∧
bλ5⊂HK4
6∂6Tλdrε≥dεf.nDεF∞LdεNr <↔≡*
≡B?~
mw"πM W⊗(Q!∃≤\zJB∧
IJ0hS(I∀2∧**5"α
JBJd~
D∪
V∃E d~:@K\id∧M~ iu"∧I~5"¬:J%,≥JZ$(h)_dr∧ i4d|uK0hP~IDt*
JBdDi1PPJ∧ %∃≥D ∀ Di1PTL→I∃≠PQ+RβZλYd"∧_ib∧Di9D|:AQ hP→
%∃Rλ%BD
⊃Q LDJ+"∧
Eλ∩Hh!_4 Ldλ∩e BDA
JRST IAPLMB ;IT'S A LAMBDA
CAIN A,QFUNARG
JRST APFNG ;IT'S A FUNARG (MORE GOOD GRIEF!)
CAIN A,QLABEL
JRST APLBL ;IT'S A LABEL (SUPER GOOD GRIEF!)
PUSH P,C
PUSH FXP,T
HRRZ A,(C)
JUMPL C,IAP2A ;JUMP IF WE'VE RE-EVAL'ED TOO MUCH
PUSHJ P,EV0 ;ELSE EVAL THE FUNCTIONAL FORM
POP P,C ; AND TRY IT AGAIN...
POP FXP,T
ILP1B: MOVE B,(C)
HRRM A,(C)
TLO C,400000
JRST ILP1
APTB1: JRST IAP2A ;FIXNUMS ARE NOT FUNCTIONS!
JRST IAP2A ;NOR FLONUMS
DB$ JRST IAP2A ;NOR DOUBLES
CX$ JRST IAP2A ;NOR COMPLEXES
DX$ JRST IAP2A ;NOR DUPLEXES
BG$ JRST IAP2A ;NOR BIGNUMS ALREADY
JRST IAPATM ;SYMBOLS ARE OKAY, BUT JUST BARELY
HN$ REPEAT HNKLOG+1, .VALUE ;HUNKS
JRST IAP2A ;TRUE RANDOMS ARE OUT!
JRST IAPSAR ;IT'S AN ARRAY - OKAY, I GUESS
IAPATM: HRRZ B,(A) ;APPLY GOT ATOMIC FUNCTION
HRRZS 1(C) ;KILL POSSIBLE 400000 BIT DUE TO FEXPR
TDZA R,R
IAPAT2: HRRZ B,(B)
IAPAT3: JUMPE B,IAPIA1 ;GRAB FUNCTION FROM PROP LIST
HLRZ TT,(B)
HRRZ B,(B)
CAIL TT,QARRAY ;REMEMBER, FUNCTION PROPS ARE
CAILE TT,QAUTOLOAD ; LINEAR IN MEMORY
JRST IAPAT2
2DIF JRST @(TT),IATT,QARRAY
IATT: IAPARR ;ARRAY
IAPSBR ;SUBR
IAPSBR ;FSUBR
IAPLSB ;LSUBR
IAPXPR ;EXPR
IAPXPR ;FEXPR
IAPAT2 ;JUST IGNORE MACROS
IAPIAL ;AUTOLOAD
IAPIAL: HRRI R,(B)
JRST IAPAT2
IAPIA1: JUMPL R,IAP2J
JUMPE R,IAP2
MOVEI B,(R)
PUSH FXP,T
MOVEI T,(A)
PUSHJ P,IIAL
POP FXP,T
HRRZ B,(A)
SETO R,
JRST IAPAT3
IIAL: PUSH P,A
HLRZ A,(B)
PUSHJ P,AUTOLOAD
JRST POPAJ
IAPSAR: SKIPA TT,A ;APPLY A SAR
IAPARR: HLRZ TT,(B) ;APPLY AN ARRAY
MOVEM TT,LISAR ;FOR INTERRUPT PROTECTION ONLY
MOVEI R,(TT)
MOVEI TT,IAPAR1
JRST IAPSB1
IAPSBR: HLRZ TT,(B) ;APPLY A SUBR
↓HRRZ R,(C)
IAPSB1: HRRM TT,(C)
JRST ESB1
IAPAR1: MOVE TT,LISAR
JRST @ASAR(TT)
IFN HNKLOG,[
IAHNK: SKIPN ICALLI ;Do we have a CALL interpreter?
JRST IALIS
PUSH P,T
PUSHJ P,USRHNP ;Is this a user hunk?
EXCH T,TT
POP P,T
JUMPE TT,IALIS ;Nope, just pretend it's a list
XCT ICALLI ;Otherwise run user's hook
]; -- End IFN HNKLOG,
IAPXPR: HLRZ A,(B)
JRST ILP1B
IAPLSB: MOVEI TT,CPOPJ
HRRM TT,(C)
MOVE R,B
JRST ELSB1
IAP2: SKIPE EVPUNT ;DON'T EVALUATE FUNCTIONAL VARIABLE?
JRST IAP2A
JUMPL C,IAP2A
HRRZ A,(C) ;APPLY FUNCTIONAL FROM VALUE CELL
HLRZ A,(A)
HRRZ A,@(A)
CAIE A,QUNBOUND ;FOOBAR! IT'S UNBOUND
JRST ILP1B
JRST IAP2A
αIAPLMB: HLRZ TT,(B) ;APPLY A LAMBDA EXPRESSION
MOVEI D,(TT)
LSH D,-SEGLOG
↓MOVE D,ST(D)
TLNA D,SY
JUMPN TT,IAP3
SETZ D, ;AMPORTANT THAT D BE FON-NEG - SEE IAP4
MOTEI C,(TT)
↓HRRZ B,(B)
MOVE R,T
IPLMB12 JUMPE T,IPLMB2 ;NO MORA ARGS
JUMPE TT,QF2A ;TOO MANQ ARCS SUPPLIED
IAP5* HLRZ A,(TT)
SKIPE V.RSET
JUMPN A,IAP5C
IAP5C: MOVEI AR1(1(T)
ADD AR1(P
HLLZ D,(AR1) ;SEE COIMENT AT EFX - ALLOWS
HRLMA,(AR1) ; A FEXPR DO TAKE AN A-LIST ARG
HRRX TT,(TT)
AOJA T,IPLEB1
¬
IAP5B: MOVEI D,(A)¬
LSH D,-SEGLOG
MOVE D$ST(@!
TDNN @$SY
↓ JRST LMBEBR
∪∃I'(A∪¬ kε~(~∃∪!1≠∧dt%∃+≠!8A)(Y%β h∩m)∨≡A→ &AβI∂&A'U!! ∪∃λ~∧∪)+≠!≤↓$Y∪!1≠∧h∩m≥≡A→¬≠¬ α↓→∪'(↓∪⊂→α5*84(Mα>AααbRP4PJ"JJJαRQ2≥α>B(KZ2ε6∀"¬α∩M~Qα&~α:V2`h(&N\JB∃α2rJN⊗ h(%α¬*N!ααbRP4PJ"JJRα¬1α∩H4(→*Tm∧dλ∩ddX)Eh!→∧e∃$λ∩bD%⊃PPL**5"∧Zh∀`h!Q$M∧IX##P→Yu$,T
5αe:
50h!~4\Mλ⊃PTM IS$ !∀¬¬-9 "¬αH)∀t ⊃↔4∀LhD¬$ JXU~¬It∧d X(D
¬h~%_h)~∧dkH' M∧z∧¬αd~&⊂HK8jTr∧λ~2∧
itrliD∧d X(D
∧I~5 h!→∧e∃$λ∩d
&⊃PPM99∃∧
λ⊃⊂HK9_b∧t→D∧
~
h∃∀L_)D*bλItb≥Dλ$LtD
DDM4λ∃∀8Q!∩∧ y)D*¬%I∃∧dVH⊂HK8¬∪dλR3Q∧λ(∪SiE3R3∧
P4R(_S⊃#!!03rIH(⊂K ~∪∪-λ↓".u 4h∃i→Th⊃*H3H∩(d∀⊂Q*I3u4d 3ThλIq4sDzλ∩U)Zβ"B*9r4∪D
KTThZβ"B$ TTu∧ 4∪∪(&#"B)
TR(λ~L+⊂j t∩H↓QB5∪ H(⊂4F∃ ,#!!(∀∃*9λ∀ λ~L#"I~∪∪0FW@2Tj∧∃ ∀jλ0rβ!!2∀TK$⊂4D%E⊂J#!!4∃4i∧∀ ⊂jYPR3HA B2 JTH⊂%E⊂J#!!2U3*λ(⊂4F∃⊃5P)A".p$λq3Q*(3∩6HXλ∪⊂)XQ⊂.D∧∪SsEYU3∪∧ ⊂30HH(∪∩*:β"S XS∀∞A~∃4r∧
⊂B!↔qStDλq3Q*(3λ∪λ→0Q⊂*5λ⊃5H→∀h∀hZ513H8(∪qDλ4∀ j1"B2 JVH⊂%E⊂J#!!4∃4i H∀ λZP3β!)∪0S
ε,B4 zλ∀ λ↓"B2
*TH⊂EE⊂J#!)∪0S
εLB2JY4∪Hλ¬∪∪0IJβ"B* t∩H
¬β"C!)4∀ShyNB3)zQ2(λ∃⊃R3↓⊃.r3JH4SP)D∀∀ShyC"B)*Tuλ I0S∀ε!"C"AQR04ε7B33jh2(⊂%E∃∃
!↔p4∀ K(∪⊃+
∀C"A→3uSD
∃ ∃↓QB0p)→λ∃∃¬K∩∩3JY#"B)*Tuλ K∀∀S !"B3)zQ2(λ~L+⊂j t∩C!!2∀TIT⊂4L%E⊂j#!!33uHY(⊂4F∃⊂3L¬
∃
#!!33uHY(∀t¬Jt∀uAQB4∃*9∩H∀¬HR3Q↓QB33jh2(⊂eE⊂j#!!16⊂i∧⊂k⊂*(s∪paQ@2∀II(⊂kλ~Qs∪h1"B4
Zrλ∀j¬⊂b"'8R3Q∧λ4Qs Xh∃∪d ∪ph xH⊂4Hzh∪sD
⊃∪β!!12⊂i∧⊂4D%H4QsJY#"B)
S∩(λ~L+⊂*(sU3!QB4∃*9λ∀t¬H4L"!↔pR3HD⊂4Qij3(∃ t∪U3((4H∪hd⊂4Qj1"B2J:λ∃
:⊃0v↓QB2∀J+H⊂K¬λJ#"A~∃4r $∀ ∪ XS∀β!!4rr* H∃ λλ4QsJY#"B)*Tuλ
YPR3HA"B2
)∀h∃↓QB4u($∀ ∃↓QB2TJ:λ∃3H)3Qβ!(u3PI→NB2J*uλ∃)hR3Q↓QC"C!)04
π!2U3*λq(⊃¬J1Lp!⊃"B0)ySH∀EJ1Hp!QB2TJ:λ∩0*ε⊂".hh6∀∀D qH∃
yh⊂4Hzc"C! ↓A"Tu(*∃∪α(j3Pu →sKλ
~3u⊃%D⊃⊃0iH4Q+∧λss3(YU λ
85∀+∧λ3Q ∧ tC"AQQU3H:∩3sG!4rr*λ(⊃ λ:1U3H:∩3sA↔qQ6
H #!*53uλWB33jh2(⊃¬J453jH"""'8Q6∀
$ #"A→U34λT⊂+∃ih1SthQ"B2
*VH∃
E
⊂*!QB2U)Z⊃(∃
E ⊂p*!"B2J*uλ∃ih1SthQ"C"HH0s⊂*(.B3)zQ2(λ∃∀1⊃(9⊂4Q!↔qTu(*H
∩(yStQ*4⊂4Qe⊃"B4 z∩H∀¬A"C"DHss3(YU∞B)YuQ2$λ+∀)λ9s31)jα.qJ:0TH¬ 1sSj(4h⊂*(j#"A~∪t∩D
β"AQC"ThZ∀.B*
4rλ
¬⊂#"J85 .A~∃4r $⊃V∀¬J ;DO ONE STEP OF A "MULTIPLE" SETQ.
SKIPE (P)
JRST SET1
JRST POP1J
SET0: HLRZ A,@(P) ;ASSUMES ARGLIST PTR STORED IN 0(P)
JSP D,SETCK ;ENTERED BY PUSHJ FXP,SET0
HRRZ B,@(P)
JUMPE B,SETWNA
PUSH P,A ;ATOM TO BE SETQ'D
HLRZ A,(B)
HRRZ B,(B)
MOVEM B,-1(P) ;CDR THE ARGLIST
PUSHJ P,EVAL
POP P,AR1
JSP T,.SET
POPJ FXP,
$AND: HRLI A,TRUTH
$OR: HLRZ C,A
PUSH P,C
ANDOR: HRRZ C,A
JUMPE C,POPAJ
MOVSI C,(SKIPE (P))
TLNE A,-1
MOVSI C,(SKIPN (P))
XCT C
JRST POPAJ
MOVEM A,(P)
HLRZ A,(A)
PUSHJ P,EVAL
EXCH A,(P)
HRR A,(A)
JRST ANDOR
SUBTTL PROG, PROGV, RETURN, GO
PROG: HLRZ AR2A,(A) ;FSUBR
HRRZ A,(A)
PRG1: JUMPE AR2A,PRG1Z ;EITHER THEY ARE NIL OR
SKOTT AR2A,LS ; MUST HAVE A LIST FOR PROG VARS
JRST PRGER1
PRG1Z: PUSH P,A
SETZ C,
JSP T,PBIND ;BIND PROG VARIABLES TO NIL
POP P,A
PUSHJ P,PG0 ;EVALUATE PROG BODY
MOVEI A,NIL
JRST UNBIND ;UNBIND VARIABLES
PG0: PUSH P,PA3
PUSH P,PA4
PUSH P,SP
PUSH P,FXP
PUSH P,FLP
LPRP==.-PG0+1 ;LENGTH OF PROG PDL, IE HOW MUCH PROG HAS
MOVEM P,PA4 ;CAUSED TO BE PUSHED
HRLS A
MOVEM A,PA3
PG1: HLRZ T,PA3
PG1A: JUMPE T,PRXIT ;NORMAL EXIT
↓HLRZ A,(T)
HRRZ T,(T)
HRLM T,PA3
SKOTT A,LS
JRST PG1
PUSHJ P,EVAL
PG0A: JRST PG1
;;; JSP T,VBIND ;LIST OF SYMBOLS IN AR2A, VALUES IN A
;;; BINDS EACH SPECIAL VARIABLE IN THE LIST TO CORRESPODNING VALUES.
;;; IF VALUES LIST TOO SHORT, "UNBOUND" GETS USED FOR PROGV, AND
;;; NIL OTHERWISE.
VBIND: MOVEI C,(A) ;INTERPRETED AND COMPILED PROGV COIE HERE
SKIPA R,[QUNBOUND] ;USE UNBOUND AS VALUE OF EXTRA VARIABLES
PBIND: MOVEI R,NIL ;USE NIL AS VALUE OF EXTRA VARS
MOVEM SP,SPSV ;BIND PROG VARIABLES
JUMPE AR2A,SPECX
MOVEI AR1,NIL
PBIND1: HLRZ A,(AR2A) ;NEXT VARIABLE
HLRZ AR1,(C) ;NEXT VALUE
SKIPN C ;HAVE WE RUN OFF THE END OF THE LIST?
MOVEI AR1,(R) ;YES, USE DEFAULT VALUE
SKOTT A,SY
JRST PBIND2
CAIE A,TRUTH ;DONT BIND NON-SYMBOLS, NOR "T"
PUSHJ P,BIND
PBIND2: HRRZ C,(C)
HRRZ AR2A,(AR2A)
JUMPN AR2A,PBIND1
JRST SPECX
PROGV: HRRZ B,(A) ;FSUBR
HRRZ C,(B)
HLRZ A,(A)
HLRZ B,(B)
PUSH P,C
PUSH P,B
PUSHJ P,EVAL ;GET LIST OF VARIABLES
EXCH A,(P)
PUSHJ P,EVAL ;GET LIST OF VALUES
POP P,AR2A
JSP T,VBIND ;BIND VARIABLES
POP P,B
PUSHJ P,LMBLP ;EVAL REST LIKE LAMBDA BODY
JRST UNBIND
RETURN: JSP T,BKERST ;SUBR 1
MOVE P,PA4
AOS -LPRP+1(P) ;RETURN CAUSES SKIP
PRXIT: POP P,FLP ;PROG EXIT
POP P,FXP
POP P,TT
PUSHJ P,UBD0
POP P,PA4
ERRP4: POP P,PA3
RHAPJ: MOVEI A,(A)
CQFUNCTION: POPJ P,QFUNCTION
GO: JSP TT,FWNACK
FA1,,QGO
HLRZ A,(A)
GO2: JSP T,SPATOM ;LEAVES TYPE BITS IN TT
JRST GO3
GO1: JSP T,BKERST
HRRZ T,PA3
PG5: JUMPE T,EG1
HLRZ TT,(T)
HRRZ T,(T)
CAIN TT,(A)
JRST PG5A
TLNN A,400000 ;4.9 BIT => GO TAG IS NUMERIC
JRST PG5
MOVEI D,(TT)
LSH D,-SEGLOG
SKIPL D,ST(D)
TLNN D,FX+FL
JRST PG5
MOVE TT,(TT)
CAME TT,(A)
JRST PG5
PG5A: MOVE P,PA4
MOVE FLP,(P)
MOVE FXP,-1(P)
HRRZ TT,-2(P)
PUSHJ P,UBD
JRST PG1A
GO3: TLNN TT,FX+FL
JRST GO3A
GO3B: MOVE TT,(A) ;SET 4.9 BIT OF A IF TAG IS NUMERIC
CAML TT,[-XLONUM]
CAIL TT,XHINUM ; BUT NOT INUM
TLO A,400000
JRST GO1
GO3A: PUSHJ P,EVAL ;IF ARG TO GO ISN'T ATOMIC, DO ONE EVAL AND TRY AGAIN
MOVEI TT,(A)
LSH TT,-SEGLOG
MOVE TT,ST(TT)
TLNE TT,FX+FL
JRST GO3B
TLNE TT,SY
JRST GO1
JRST EG1
SUBTTL DO FUNCTION
DO: PUSH P,PA4
SETZM PA4
PUSH FXP,R70 ;A "DO SWITCH" TO MARK EXPANDED FORMAT
PUSH P,A
HLRZ A,(A)
SKOTT A,LS ;HUNKS WIN AS WELL AS LISTS
JUMPN A,DO4A
HRROM A,(FXP)
HLRZ A,@(P) ;SETUP FOR MULTIPLE INDICES
HRRZ C,@(P)
HLRZ B,(C)
JRST DO4
DO4A: MOVE A,(P) ;SINGLE INDEX DO
HRRZ B,(A)
HRRZ B,(B)
HRRZ B,(B)
MOVE C,B
DO4: HRRZ C,(C)
MOVEM A,(P) ; (P) PROG BODY
DO4C: SKOTT B,LS
JUMPN B,DOERRE
PUSH P,B ; -1(P) ENDTEST
PUSH P,C ; -2(P) DO VARS LIST
MOVE A,-2(P)
MOVSI R,600000 ;EVALUATE AND SETUP INITIAL VALUES
SKIPN -1(P)
MOVSI R,400000 ;200000 BIT SAYS STEPPERS ARE OKAY
PUSHJ FXP,DO5
SKIPN -1(P)
JRST DO4D
DO7: HLRZ A,@-1(P)
PUSHJ P,EVAL
JUMPN A,DO8
DO7A: MOVE A,(P)
PUSHJ P,PG0 ;DO PROG BODY (MAY SKIP ON RETURN STATEMENT)
JRST DO2
DO9: MOVE B,-2(P)
SUB P,R70+3 ;BREAK OUT OF BODY BY RETURN STATEMENT
POP P,PA4
SUB FXP,R70+1
JUMPN B,UNBIND
POPJ P,
DO8: SKIPN A,(FXP)
JRST DO9 ;SIMPLE DO FORMAT
HRRZ B,@-1(P! ;DO PASSED ENDTEST, AND REPUBNS A VALUE
PUSHJ P,IPROGN
JRST DO9¬
DO2: MOVE A,-2(P)
MOVEI R,0 ;DO STEPPING FUNCTIKNS
PUSHJ FXP,DO5
∪∃I'(A <n~∀~) ≡iλh∪≠∨-∀AαXQ@R~∀∪A+'⊃∀↓ Y!∞@~∀∪'∃)4Aα0∩∩∩w⊃
β+1(A-β1+
A∨_A∨≥π∀[)⊃%=+∂⊂A⊃≡A∪&↓≥∪_~(∪∃%'PA ≡r4∀~∃ <jt∪∃U≠!
A∧Y ≡l$∩w ∨∃&A!βALLEL SETQS - OJ LISPS LIKE (I V!T∧dR~(∪!+π A Yα$∩w/∪1_A ≡Q' )DA∩A DRAβ ↓$@x@@~∀∪'-∪!
@4bQ
⊃@R∩∩w]∪→1∧"=↓α≤*REαJαQI%∧J→αIβq↓@4PIα"2∃Qα¬1D $$%\J→α∩⎇~]αN
JMαNLr≡2∃∧J:α⊗@aαR",qα>:eIα>:*α2&N h*∩=- h&6⎇2⊗%α∩a"¬$hP&*Vmα≡∃α⊂b∩=V0h(&N\zRQα
bNd$KZ¬αNLr≡2⊗$z9αNLj
>0hP%α*∃~Qα∩{*ED$KZ:>B*qαRJJα~VJ$BVIα≤B⊗∞._h(&"∀bbMαλH$%n%∩⊗εQ∧
M↓!e~f6
|ayα:La$4(L*b∞!∧ 1"AHh(&*∃~Qα∩{* 4(hR∩=V `&N\zRQαλb2L4PIα*J≥!α∩≡-∩H$(LB2JI∧ 1" Hh(&*≥↓αQ2≥αεR≡hh(%αU∩NQα$z⊗JHhP&RIhR¬∩F&βββ∧↓PPJ *%≥"λIs,0Q!∀E∃+$∧
bλ%⊂hPα2U)Z⊃(⊂%H∪m1AQ@2∀J+H⊂+¬λ*#"A→U34 d⊂+⊃ v14C!(∪m1G!2∪∀K$⊂+
λ%#"B)
S∪(λ∃
∀
!Q@2∀J+H⊂+¬λJ#"A→U34 D∀K⊃ v1#"A→U34λT⊂+⊃ v0C"A→∀TVDλ+
⊂%⊃"B2JY4∪Hλ∃⊃∪m(A"Q∪fXNB4 zλ∀ λ⊃"B4iyP(∀EH∪m0aQ@↓A Q∪fX.B2JY4⊃(λ∃⊃∪m(q".j ∃(∩4d
p31$λ4h
∀∪R3¬∀⊃s@ →R5∩(→λ∃P)J1#"HIm1∞A→∪∀VDλ+
⊂%⊃"B4
Zrλ⊃K
∀C!!4∃4i H∀ λZP3β!!4∪t∧λV∀
!"Q∪fXnB2 Iλ⊂+¬
#"A_6⊂r∧λ+
∀¬⊃".sIzh
∀¬∀∩⊂4d∧⊂5∪iU ∃P)J1#"HIm0nA→∀TVDλ+
⊂%⊃"B4i94∪H¬V*⊃V
¬#"B)YuQ2$λ+ α!↔tsh
I⊂5λ
93QsλT⊃StIX5λ⊃ t∃r3 D⊃∀Sj∧∪u5↓QB03i((∀CλIm#"AQQ∪mG!5∀SId∀K &⊃".ve
q5∀$ (∃L%∀⊃TSiT⊂0Sjh7#"A~∪t∩DλV∀ ↓⊃.qR**uλ∃ →1(∃
Su1i¬λ∃q$λ3∪∪jT⊃s⊃∧λR3Q →Qtc!!2U3*λq(∀EH∪mPa⊃.q∪dλQ(∀HY130HZQ1λ YH∃∩λT∀t⊃ D⊃StD
3PR)H∩3QaQB2∀J+Th∀AQB33jH3(∀j¬∀p∀ja"Q∪fH.B4 zλ∀ λ~L#"A→∪∀VDλ+⊂4F⊃"B4
Zr∩H
¬⊂R3HA B4iyQh∀EH∪mP!Q@2Tj∧∃ ∀jλ0vβ!!4∪t $⊃R∀¬A"C"HImPnA~∪tλ
¬⊂4L!↔q∃4I→Qh∃ λ(⊂uλZ∀∩3Ht∀∩⊂*8+λ⊂*4∪t∀ zq1λ
Ic"B) ∀VHλ∃⊂4L!↔u∩⊃$ 3R5 _3∩6H~⊂3sD
∩⊂4hUλ∃q$ ⊃5λ ih⊂R)H∩3Qj1"B4
Zr∩H
¬⊂R3HA.p0h~353λ~⊃(∪id∃∩⊃$
t⊃∪↓Q@2Tj∧∃ ∀hZ⊗∩5↓QB4si(h∀KλImPc!!4∪t $⊃V∀¬A"@↓A"Tu(*∃∪α(9sQ ∧λ4TThZ λ⊃**Kλ⊂h~⊂r ∧
∩∀Sjuλ⊂p*8+λ∩(eλ
Ph~⊂r ∧¬U∩∀Izkβ"G153Ui→Q 4
)u⊃0jEλ⊂p*Hr⊂3 Eλ⊂p*Hr 0H~TR1*!"Psih .B)
TVHλ∃
⊂J!QPssHGB2U)Z⊃(⊂%Ht∪t !.q3JJV#"A~∃4r∧
⊂#!!2∪∀K$⊂+
λ∃#"B) ∀VHλ∃
⊂*!QB0p)→H⊂+
JU5∩↓QB(∩J*uλ⊂iyLc"A_p31$λ+∃U¬i5⊗#!!(∀∃*9∩H∀¬H5P3↓QPssF7B4∪j∧∀ ⊂AQB2U)Z⊃(⊂%HssQε⊃.r1DλR4TjD∪qHλ9sQλ
λ24H ~h∃∀JX#"B) ∀VHλ%
⊂J!QB4ri~⊂#"H9sQ G!4∪t∧
⊂C!!2∀TK$⊂K
λ%#"B)*34⊃$λK⊂t z∩B.iIstλλitH⊃hYQ4P)I6Q1∧λssQ∧
⊂24AQB4∃*9λ∀ λ!"B2 JVH⊂%E⊂J#!!4∃4i H∀ λZP3β!(ssLG!2TTjD⊂ssHFC"C!!"PRhZTu∞A~rr4 d∃∃
λ-β"A∀∩TTjD⊂RtJ: #"A~∪⊗H
J ,!QB4ri~⊃(⊂EHp5∀JIC"B$ TTu∧λRtTjFC"PI:Tu g!4rr*λ(⊂KλZTU∪AQB(⊂h→3⊃(
J
⊂E⊃"B(∧ TTu∧¬∃
"!↔sSh
JSu0IH4ss(T⊂p5λ9∀h∪j$⊃4TJ85∀c!(RtTjF∞B3)zQ2(
J ⊂RhZTuβ!(RtTjF∞B3)zQ3(
J 3λZTu∀¬λJ".h*Q02d
4λ⊂$
∀Su()⊃4siX(⊂p*Hrλ∪j$⊃4TJ85 λλUQkC!!2∀TK)(∃∃¬E⊂J"!↔uq(
x3Iu∧
∪h⊃hZλ∀R(D∪qH
I∩4hλjP31%D∩⊂3HI⊃(⊂)Iλ∃3Jy3Q *
Su⊃(:∀c"A⊃"".d 3Ps
X∩3Qd
∩⊃(λjP31$
q(∃h→Uλ∃ t⊃S∃*9β"B*
4r∩DλV∀
YUt∀Iq"B0h→3⊃(
J
∀¬⊃".r(d∀λ∪λZth∃ λ3H⊃J(31( xH∩3JH4Q4jEλ∃∩λYH∩5∧
p4hλ→C"B!⊃".h
YUr3HE4∀SjH0uλλjP31$λ3Qλ
YUt∀It∃∩∀HZh∩5∧λ5p6%dλ∩U*:β"B!⊃".h
(5∃4Id∃∪h z4H⊂h→∪⊃4Ea"B( *Tuλ¬
#"A⊃"".hY∀q(
I∀Sud
∩⊃(λjP31$λ5p6$λV(∩λ→Qβ"A→3uQ$
⊂B!↔j∀∀Ixh
⊂%∀λ
⊃**Tq5∧¬∀Q5
ZSH
λish⊂%∃**#!!2TTjD⊃4TF⊃".p)hλ∃∩λYH∃∀K∀⊂Rq**uλ⊂(x23C!!"PRj*u NA_p23λT∃∃ ¬λJ#"A∀∩TTjD⊂RtJ: b"'8p5⊂i∧∩4sDzλ∃∀Iz0S⊃*9s1+∧
sh∃λZuλ⊃IzH⊃4J*q5∀aQB2TJ:λ⊂Rj*u
α!↔p2 ∧λp5⊂i∧∩4h
JSu0IH4ss(T#"C!(RtTjF.B3)zQ2(λ∃∪⊃sj!"B)(h0h⊃)ZlLC! ↓A"Q4J*q5∞A→Ttλ
J ⊃Uih0rc!!1P,&% ∀1**Tq5↓QB33jh2(⊂eJ∀U5 ↓"B2
*VH⊂EE⊂*#!!2U3*λ(⊂KλZTTuε1"B4
Zrλ∀¬H#"B) ∀VHλ∃
⊂J!QB4∃*9∩H∀¬H5P3↓QB33jh2(⊂eE⊂*#!!4∪t∧
⊂#!(4TTjFnB2J:λ∃ λZTu∀↓QB33jh3(∀¬H4TU a"B3)zQ3(λ5⊃4TJ:c"B) ∀VHλ∃
⊂*!QB4∃*9∩H∀¬H5P3↓QQ4TIk∞B4
Zr∩H
¬∪Psijb.sIzS03∧λ6∩5↓QB2TJ:λ⊃4JYLβ"AQQ4TG!2Tt∧
∃ ⊃JyP0raQB1P&ε,K
_4TC!!2U3*λ(⊂+λZTLC!!2∀TK$⊂K
λ∃#"B)*34⊃$λK Jf1"B( ∀VHλ%
⊂J!QB(∩JY4⊃(λ%⊃4TF8#"B) ∀VHλ∃
⊂*!↔q5P)D⊂Q1IzQ(∃)hS∪pi93Qc!!4∃4i H∀ λZP3β!!2TTjD⊃4TF!"C"HZTLp'!4rr* H⊃4J*∪C"A∀∩TTjD∪∀t
(5β"A→3uQ)∀∃ ⊃**Lc"A_6⊂r∧
3λZTu∀¬
#"A→TTu∧λ4TL↓↔u3PIIprh
I⊃(⊃**Tq5¬D∃∩⊃)a"Q4J&nB4i94⊃(λ⊃".q*h3λ∃ λ(⊂4Ht∃∪hλZTC"A∀∩∪∀K$⊂+
λ∃#"B*
4rλ
¬∃β"A→TTu∧λ5P3↓QC"C!'j
Ph~⊂rλπN_9k-}K;~.> ;yE↑_9|gd→,(¬d H D ;J#!'h∃⊂(t∪tH
H1k3 ~uλ∩*4⊃5P)J05⊃(EHλ∃ λ3H⊃&∀∃∩∀Iz1rλλYH⊂4HT⊃5P)H1 H∧ 1H⊂$
∩∀Sjq"Nh zH
U
Suh ~h⊃∪ih(∃∩λYH∩4d ∩2q$λ(∀Q(z3⊂4Dλp5⊂i¬C"KH85⊂rπ!4∃4i∧∀ ⊂!⊃.tp*h(∀∪i→U⊃4D
∪h⊂*(tc"A→∪∀VDλ+
⊂%⊃".q*h3λ∃λ_ku⊂(u3∩4jA"B4
Zr∩H
¬⊃5P)A"B2
)∩(⊂%Hp5∀jλw⊂p*I∩4b'8S⊂1d 5λ⊂*4∃⊂1eY∩4u↓QB4riz∃λ⊂%I∀b"'94h∩*D⊂(∪ ~u∂c!!(∩∀J+Th⊂!⊃.h∪It∩5λ ~sIu∧ ∩4u↓QKPp*Hl.B* tλ∀¬HB""':Q4u zQ(∀ y3U⊃*$∃∪hλ~Qtc!!2Tt∧
∃ ⊂h~∀∀l!QB2∀J+H⊂K¬λJ""'8q∀H
I⊃(∪ ~uλ∪hd⊂4Qj1"B4
Zr∩H
¬∩4∀IxsB"'934∪ _r5λ
SqsDλ4Su)hλ∃∩λY#"B)*Tuλ
I∀P3 A".u λ3H⊂J(02k*Zλ⊂u**Q3U∧λp5⊂i∧⊃TP)X#"C!!"Nh¬λp5⊂i¬0P4J)14HπM~<⎇¬]yK= ≤|oHλV( H¬d H⊃-e#"Nd ∩4u¬YqK5λ_th∩*4⊃5P)J05⊃(EHλ∃ λ3H⊃&∀∃∩∀Iz1rλλYH⊂4HT⊃5P)H1 H∧ 1H⊂$
∩∀Sjq"Nh zH
U
Suh ~h⊃∪ih(∃∩λYH∩1D
⊂1h ~h∩3D ∩4u¬YqK5λ_tkλ
I⊃(⊂h~⊂r ((4TR(ZH∀Q*J4STeA"NhλY∀q(λ→H∃3J813K(85⊂r¬Z⊂1hλZTStD 4h⊃hYQ4P*H1β"H85⊂rλ'B4∃*9λ∀ λ⊃".th~Q(∀ y3U⊃*$∃∪hλ~Qtc!!2∪∀K$⊂+
λ∃"".hZP3λ
H1kuλ_k3∩*:β"B*
4r∩D
⊃5H→β"Ph~⊂pLG!4rsjJλ⊂+ Jb".i~h∩5∧λ(∪∩*:∂c"A∀∩TTjD⊂p5λ8L""'9St⊃%D⊃4TIzC"B)
S∩(λ∃⊂p5
:⊂w⊂h~∪∩4kHp5⊂h_H∞v(Zkλ⊃IH1h⊂h~⊂rλλjP31$λstTHXu∪⊗!QB2TJ:λ Ph~⊂l"!↔tQ4jD∩4h *4uλ I2q(¬(p5⊂i↓"C"H85⊂pF↔B5uλ∀⊗s5*:λ⊂Q$λ(∪∩*:λ∪qD
⊂1td¬(⊂p*Hr 0H~TR1*$7#"A→TTu∧λp5⊂h&C"C!!"Njλ85⊂rλ→∪λ→N]X⎇~-⎇H→,$¬H H¬d→;J!QNh⊃JYPu∩)yH∩4dλ(⊃U)hu∩3id∪qH
Jsh⊂*(tkH∧λ,(∃
Su1i∧⊃3Hλ~Q(⊃*h3⊃1¬D⊂3Q∧ 1H∪Iq"Nh
I∀Sud 4h⊃ yQ(∃ λ(∃P)J1(∪hd⊃3H ~h∀Q*J4SQ(EHλ∩(d⊂3V$
∩∀Sjt∩4hλIsQ+∧λU3PjI3sC!'h∩4d 3USi81λ∃i~∩λ∃ λ(⊃R**uλ⊂*(h⊂Q)→Qh∃ λ(∃∩
)uh∃λ_h⊂3HD∃∩⊃$
q0sihλ⊂Q)→Qh∃ λ#"Nd
∩∀SjyH∃P)J1+H∧
∩⊃(
h3∃1$ qH∃ λ(⊃U)hu∩3id∩4h
I⊃3H
(5∃4Ih1λ⊂*4∃∩⊃$
P3∃(Q"Nh xH∃∩λT⊂p5λ9⊂3∪¬a"Pp*Hr⊂3 GC"B*
4rλ
¬⊂""':p5Q$
∪r3JH4H∃ t⊂4Qj1"B2 JVH⊂%E⊂*"!↔q5P)D⊃U3H:∩3sAQB4∃*9∩H∀¬H5P3↓QB2∀II(⊂+λ85∀tλ;⊂p5λ→∪α.hiAS A CATCHALL
JRST .CATC1 ;REST IS LIKE *CATCH
;(UNWIND-PROTECT e u1 u2 . . . un)
; EXECUTES U1 THRU Un WHEN THE "CONTOUR" OF THE UNWIND-PROTECT IS EXITED.
; IF e TERMINATES NORMALLY, THEN U1 THRU UN ARE EVALUATED AND THE VALUE
; RETURNED BY e IS REDURNED. IF A NON-LOCAL EXIT OCCURS THRU AN UNWIND-PRO
; FRAME, THEN U1 THRU UN ARE EVALED AND THE EXIT CONTINUES.
UNWINP: HRRZ B,(A) ;GET CDR OF ARG LIST
HRLI B,CATUWP\CATSPC ;AN UNWIND-PROTECT FRAME
MOVEM B,CATID
PUSH FXP,P ;SAVE CURRENT STATE OF STACK
JSP T,ERSTP
MOVEM P,CATRTN
HLRZ A,(A) ;CAR OF ARG LIST
PUSHJ P,EVAL ;EVALUATE IT
HRRZ TT,(FXP) ;NOW MUST RUN THE UNWIND PROTECT FUNCTIONS
PUSHJ FXP,UNWPRO ;UNDO THE UNWIND-PROTECT FRAME
POPI FXP,1 ;REMOVE THE SAVED PDL POINTER FROM FXP
POPJ P, ;THEN RETURN THE VALUE OF e
;ERROR TRAP FOR UNWIND-PROTECT, SHOULD NEVER GET HERE!
UNWERR: LERR [SIXBIT \UNWIND-PROTECT LEFT DUMMY RETURN ADR OJ STACK!\]
;COMPILED UNWIND-PROTECT, ENTER WITH JSP TT, CONTINUATION IS AT PC C(TT)+1
PTNTRY::
UNWINC: PUSH P,[UNWERR] ;IF GETS HERE, HMM...
AOS TT ;POINT TO START OF CONTINUATION
HRLI TT,CATUWP\CATCOM\CATSPC ;AN UNWIND-PROTECT FRAME
MOVEM TT,CATID
JSP T,ERSTP
MOVEM P,CATRTN
JRST -1(TT) ;RETURN TO COMPILED CODE
;COME HERE TO CLOSE UP AN UNWIND PROTECT. CALLED WITH JSP TT,
PTEXIT::
UNWINE: MOVEM TT,-LEP1-4(P) ;SAVE RETURN ADR (AN EXTRA SLOT IS ON P)
MOVEI TT,-LEP1(P) ;ADR TO UNWIND TO
PUSHJ FXP,UNWPRO ;UNDO THA UNWIND-PROTECT FRAME
POPJ P, ;THEN RETURN THE VALUE OF e
;(*THROW TAG VAL) SUBR
.THROW: EXCH A,B ;THROW1 WANTS TAG IN B, VAL IN A
JRST THROW1 ;THEN DO A THROW
;;; WITHOUT-INTERRUPTS: ROUTINES WHEN PWIOINT GETS BOUND AND UNBOUND
;;; CALLED from SPECBIND, new value in
;;; R has new value, T has address of word with address in right half.
WIOSPC: PUSH P,TT
HRRZ TT,(T) ;Get address we were trying to clobber
CAIN TT,PWIOINT ;Our special hack location?
JRST WIOSP0 ; yes, hack it
POP P,TT
EXCH R,@(T) ↓ ;Otherwise redo instrucTion to get real int
JRST SPEC4A ;And continue with the SPECBIND if continued
WIOSP0: MOVEI TT,(R) ;New value to TT
SKIPE REALLY ;If UNWPR1 has it living on the stack
SKIPA R,@REALLY ; Get old value for SPEC4A from there
MOVE R,UNREAL ; Else normal.
JUMPE TT,WIOSP1 ;NIL, use as is
CAIE TT,QTTY ;TTY, that's meaningful
MOVNI TT,1 ;Else use -1
WIMSP1~ PUSHJ P,WIKBN⊂ ;Store into UNREAL, maybe runCHECKU
POP P,TT
JRST SPEC4A
;;;CALLED FROM @IND, NEW TALUE IN AR1
WIOBND: HRRZ TT,UNREAL ;CURRENT VALUE
HRRM TT,(SP) ;REMEMBER INSTEAD OF MEANINGLESS VALUE
MOVEI TT,(AR1)
JUMPE TT,WIOBN0 ;NIL, USE AS IS
CAIE TT,QTTY ;TTY, THAT'S MEANINGFUL
MOVNI TT,1 ;ELSE USE -1
WIKBN0: JUMPL TT,WIOBN1¬
PUSH P,A
PUSH FXP,D
PUSH FXP,F
MOVE A,TT
PUSHJ P,ABIND3
PUSHJ P,CHACKU
POP SP,SPSV ;SO RE-OPEN THE BIND-BLOCK
POP FXP,F
POP FXP,D
POP P,A
POPJ P, ;RETURN FROI BIND
WIOBN1: MOVEM TT,UNREAL
POPJ P,
;;9 CALLED FROM AFTER UNBIND -- (FLP) HAS OLD VALUE IJ LH. CAN ONLY DESTROY T.
WIOUNB: EXCH D,(FLP) ;GET OLD VALUE, SAVE D
PUSH FLP,F ;SAVE F ALSO -- CHECKU MAY CLOBBER
PUCH P,A ;A WILL GET NEW (OLD VALUE @∨ ↓+≥% ¬_~∀∪!→%4A∧Yλ∩∩@@w
%∂+%
↓∨+(AI β_A=→λA-¬→+
~(∪πβ∪8AαXZD∩∩@@w∪ A!β→
∂=%λ@ZDXA)⊃∃_A)+I≤A∪≥Q_
α~,b2↑>∀ 4(¬∧j>Z:Jα¬1DhP&N.Mα∃αJ,
22dhP%↓αU∩NQα<J>V9λh(&B-~")ααb∞"⊗≤ZT$%α↓↓nJ,qα&:$*JJV¬"Mαε~αεBB∀zBJ&
"∀4*<J>V9βP&B>ααA2∧HH%↓↓βZJ⊗N$zJ∃α →≡Mα r⊃αJ-"VJ8hP&B>αα~2Ad04(&∧zAα~e↓2⊂4PJB>BRαA04Ph*↑&⎇*9EhLj>Z⊗jα¬2α∀*ε22HH%↓↓βZOS?⊗)β'Q∧K9βSF)βOπ6+⊃βOf{P$(LRJNQ¬:&>Vs4(04
≤
N⊗ESX&R∩T αI2⊂H%n~d
≥α&rαIα↑D*R"⊗⊂α∞εN*zD4)\~εN∃PJN⊗R|IαI0hP&*Vmα∃α¬d~B>BPH%n⊗u"Je1¬∩⊗RV∀qα:&bα&→αtyαεJ=_4(&¬*N!ααb∧$%]~εZ∃¬α>&:$*IαRzαεJ≥∧b&NPhP&"2∃Qα¬1D $$%\:⊗Qα-BBJ⊗≥~&>9¬"=α6
"∞!α :ε&:≥ 4*∞
~⊗∃iXJBVNBα~bAe⊂4(&≤
&∃α
bRJV$@$%n4zIαN∧*⊗⊃1∧~"⊗∞Zα~>I¬~B⊗∞L
1α.Lr⊂4(JαBVNDQαA2-2ε04SX&B>αα~bAe⊂4(&U*6B∃∧ 2∞ε≤*L$%\r&1αM→α¬α≥J6
>`h(&6⎇2∃αQdλ4(&e~!αQbjN⊗≡dz≤4(Lj>Z∃¬!2NQE!$4(M"2:∃¬!2~`HIn~&DrV5α-BBJ⊗≥~&>9xh(%αU∩NQα≤
N⊗_hP&R2t)αQ2≥H$%n≥J6
>bαεMα-BBJ⊗≥~&>9xh(%αU∩NQα≤
N⊗LhP&↑R
αm↓5jαεJ≡,j⊗:Q¬"=α∞
~⊗EαM→α:⊗M""⊗I∧ α~&DrV5αtzIᬬ~f6
|aεt4PJ*JN"α∞εN,($%n<J9α&2αVN⊗∩αRJ&-→αε≡ J84(hR∞εN,1h&6⎇2N%α"b~`$KZR⊗N"αε≡εLrNQα4Jb:Vm→α>:eH4(&U∩NQα≤
N∃DhP4*∞
~⊗MhLj>ZNJαQ2NHH%nR-~Qαε<
&:N"αNf6∀z2Mα|r2d4T~εN∃ P&B>ααA2λHH%nB|J:R⊗∩αR=α≤
N∃≡~αεJ≡,j⊗:R_h(&B-~!αAdλ$%n- αR⊗≥!αε≡ J:NQ¬~f6
|aαJ⊗%*J:⊗ h(&"∃∩iα¬bB $$KZR"∃∧b&NQ∧z→α6
"∞"&t9αN⊗%→αε:"α⊗bB∃_4*∞
~∃F∃PJBVNBαA2∧hP&"2∃Qα¬1D $$%]""∃α∧z&:R-⊃αR=¬""∃αt*bQα≤*Q>⊗EαJMα∧
&H4PJ"2JRα¬1"
H$%n$B∃α2M~Qα>2α6εR≤B⊗Mα⎇⊃αR"*αN&:<b∃α6
"∞ 4T~εN∃ Ah&∞ J∃α¬e"JVR@H%n&2αQαRD*9αεr↓≡>RD*J↑&≤)≥α∞d
VN∀hP%α∞ j9α¬e2Q:&%I$%Zα7πg⊗)β¬αtJ1↓∨'∪WS#O#e≥1εI;∃9b↓∞Q↓xh(%↓∧RJNQ∧~εN⊗hh(&6⎇2⊗%α%!1"¬Hh(&2≤AαRQbjN⊗≡dz≤4(Lj>Z∃¬"Q2N"BRQ$hP&R∩tqαRQdbL$%\JMαRD)α6ε$~"&::αN⊗Q∧ α2&≥!|4(Jα*JN"α∞εN+
D$%\r=1αD
:∩2*αNB⊗≤Jε22Hh*∞ε≤)F⊃hMαVN!¬↓2∧4PJ"2JRα¬1"
H$%n<*Qα:-BQα⊗d*6⊗: h*∞ε≤)F i\RV6B*αI2∞
~∃F∧HIn∩>r:Qα⊗4
2Vε$)α⊗b¬⊃α&→∧~εN⊗λh)l&≤
&9α
bRJV$@4)lJα*JN"α∞εN+
∧4)XJBVNBαA2PHInNε4)α~2 :Mα>4*Iα⊗4
04)XJBVNDQαA2-2ε04SX&B>ααA2PhQl&N-"=αI`H$%nl
.∃α≥*J∃α4bε≥αM→αNRLb1α∞⎇∩J⊗∞ h*∞ε≤)F¬hM"2:∃¬!2NdHIn&→¬"⊗NRLr≥α~⎇⊃αNfl∩>2LhP%α*,jB∃α
b∞εN+
h$%]""⊗9∧r&1αM→α¬α4
2&⊃∧z:∀4PJ6>Z,IαRQbB¬$4PJ2N!¬"Q16≤*≡2>8h(&R$r9αQe~Q"R"H$%nl
R∞"Lr≥αRMα∃|4PIα*J≥!α∞ε≤)F 4T~εN∃
Qh&B⎇↓αA2⊂h(&*≥↓αRQd~εN⊗≤X$%ntz9αN\JAα&2α6εR≤@4(%∧RJNQ∧~εN⊗hH%n6
"∞!α4zV:⊃bαBJ>≤*NMα-BBJ⊗≥~&>:_h(&"∃∩iα¬bB $$KZ≡⊗Q¬""∃α≤"H4(LRV6Brα¬2∞
~∃F⊂HIn&→∧j>J∃∧jεR∞DJ:≥αLqαR"M→α2&≥!αR",qαBJ|~⊗⊗⊂hR∞εN+
≥h&∧zAαAdλ$$%]∩⊗NR⎇∩∃αRD)α2&≥!α>→¬αε&J~αB>&u"⊗H4PJ"JJRα¬1"
H$%n$B∃α∞%⊃αB>LrRMα$yα:⊗E!α∞>u_4(εU*6B9∧ 2∞ε≤)F∀$KZ&→αtzQα⊗t!α>→∧b&NQ¬""⊗9¬αJ>∞,*⊂4(Mα>B%¬↓1D$KZ≡⊗Q¬∩&⊃α|1α6ε$~"&::αB>&u"⊗H4PJB>BRαA04Ph*∞ε≤)FEi\RV6B*αI2∞
~⊗
DHIn&→∧~εN⊗
α2⊗ε4)αV:-2ε2V
"⊗⊂4SX&BV≤AαA2 H%nN
2∃α~d
≤4)XJ∞ε&*α¬2R∃*R 4SX%αB-~")ααb⊗Zε`h)l&∧zAαAe 4)lM~⊗R=¬⊃0$$KZ~2ε:α6VN"α
∃α≤*Qα&2α∩&⊃∧*Zε0hR∞εN,∩Eh&$b:∃α"bNd$KZ&→α$*NR&t9α~>∩αNf6∀z2L4PIα*Vmα∃α¬d~εN⊗∃P$%n$B⊗9αL IS A VALID ONE
MOVEI TT,(A) ;TYPE CHECK UNEVALUATED MATCHING ARG
LSH TT,-SEGLOG
TDNN T,ST(TT)
JRST CASEAQ ;NOT MATCH
CASEBZ: JSP TT,CASECK ;NON-SKIP IF MATCH
SKIPA
JRST CASE1G ;MATCH NOT FOUND
CASEM: POP P,A ;GET BACK POINTER TO CONS WITH MATCH
HLRZ A,(A)
MOVEM A,(P) ;CLOBBER MATCHING ARG WITH EXPR LIST
SETZ A, ;MAKE SURE RETURN NIL IF NOTHING TO DO
JRST COND2
CASECK: TLNN T,FX ;USE EQ FOR ATOMS, = FOR FIXNUMS
JRST CASEEQ
MOVE D,(A) ;GET THE FIXNUM
CAME D,@-1(P) ;CHECK USING =
JRST 1(TT) ;SKIP FOR FAILURE
JRST (TT)
CASEEQ: CAME A,-1(P) ;EQ CHECK
JRST 1(TT) ;SKIP FOR FAILURE
JRST (TT)
CASEAQ: WTA [DOES NOT MATCH MATCHING EXPRESSION TYPE!]
JRST CASE1H
CASE1C: POP P,A
WTA [DOES NOT MATCH MATCHING EXPRESSION TYPE!]
JRST CASE1D
IFN 0,[ ;TEMPORARILY(?) REMOVED
IF: PUSH P,A
HLRZ A,(A) ;TEST EXPRESSION
CAIE A,TRUTH
PUSHJ P,EVAL
POP P,B
HRRZ B,(B)
SKIPN A
JRST IF1A ;FOR FAILURE EVALUATE ALL REMAINING FORMS
HLRZ A,(B)
CAIE A,TRUTH
PUSHJ P,EVAL
POPJ P,
IF1A: PUSH P,B ;COND REQUIRES POINTER TO LIST ON STACK
JRST COND2
];END IFN 0
SUBTTL "SYSTEM" MACROS - SMALL FSUBR'S TO PARALLEL COMPILER MACROS
;;; CURRENTLY: PUSH, POP,
COMMENT | FOO! SOMETHING HAS TO GO!
SETF: PUSH P,A
JRST SETF1
SETF2S: PUSHJ FXP,SET0 ;Handle a symbol case as if it were SETQ
SETF5: HRRZ B,@(P) ;BASIC LOOP DOWN ARGLIST
HRRZ B,(B)
JUMPE B,POP1J
MOVEM B,(P)
SETF1: HLRZ A,@(P)
SKOTT A,LS
JRST SETF2S ;setting a symbol?
HLRZ A,(A)
SKOTT A,SY
JRST SETF3 ;Random format?
MOVEI B,QSTF.X ;or has SETF-X property?
PUSHJ P,GET1 ; then go slow route thru SETF3
JUMPN A,SETF3
MOVE B,@(P)
HLRZ A,B ;Else check if it is one of the simple
HLRZ A,(A)
JSP T,IC.RP ; forms that we can un-do by hand
JRST SETF1B
SETF2C: PUSH FXP,TT ;A "CARCDR"ING, with "icarcdrp" code in TT
PUSH P,B ; or else TT has -1 for PLIST
HLRZ A,B
HRRZ A,(A)
PUSHJ P,EVALCAR ;Compute <arg> in "(CARCDR <arg>)"
EXCH A,(P)
PUSHJ P,EVALCAR ;Compute <val> in "(SETF (CARCDR <arg>) <val>)"
MOVE B,A
POP P,A
POP FXP,TT
JUMPL TT,STF2C2
LDB D,[0606←30 TT] ;Code for the "tail" operation and
JUMPE D,STF2C1
LDB D,[2706←30 %CARCDR-2(D)] ; find the "boy" number for it
JSP T,CARCDR(D) ;Execute the "tail" operation
STF2C1: TRNN TT,1←12. ;Bit 2.3 of code number is 1 iff
TDZA D,D ; "head" operation is RPLACD
MOVEI D,RPLACD-RPLACA
PUSHJ P,RPLACA(D)
JRST SETF5
STF2C2: PUSHJ P,SETPLIST
JRST SETF5
SETF1B: CAIE A,Q$GET ;Continue discerning for known operation
CAIN A,QCXR
JRST SETF2G ;GET, CXR
CAIN A,Q%ARRAYCALL
JRST SETF2A ;ARRAYCALL
SETO TT,
CAIN A,QPLIST
JRST SETF2C ;PLIST (A BIT LIKE CARCDR)
MOVE C,A
MOVEI B,QMACRO
PUSHJ P,GET1
JUMPN A,SETF1C
MOVE A,C
MOVEI B,QAUTOLOAD
PUSHJ P,GET1
JUMPE A,SETF3
PUSH P,A
MOVE A,C
MOVEI B,QLSTF.X
PUSHJ P,GETL5 ; BUT MAYBE WE'VE ALREADY TRIED TO AUTOLOAD?
POP P,T
JUMPE A,SETF3
MOVE A,T ;IF AUTOLOADABLE, MAY PUT A MACRO ON
PUSHJ P,AUTOLOAD ; SO LOAD IN THE AUTOLOADABLE FILE
MOVE A,C ; AND TRY AGAIN TO FIND MACRO PROP
MOVEI B,QMACRO
PUSHJ P,GET1
JUMPN A,SETF1C
MOVE A,C
MOVEI B,NIL
MOVEI C,QSTF.X
PUSHJ P,PUTPROP
JRST SETF3
SETF1C: HLRZ A,@(P)
CALLF 1,Q%MCX. ;MACROs (or STRUCTURE-selector ings)
JUMPE A,SETF3 ; - then merely MACROEXPAND-1* and go
HLRZ A,(A) ; around loop again
HRRZ B,@(P)
JSP T,%CONS
MOVEM A,(P)
JRST SETF1
SETF2A: HLRZ A,B
HLRZ B,(B)
PUSH P,A
PUSH P,B
JRST STF2A7
STF2A5: PUSHJ P,STOREE
STF2A7: SETZM LISAR
PUSHJ P,EVNH0 ;EVALUATE ARRAY REFERENCE WITHOUT HOOKING IT
SKIPN A,LISAR ;ALWAYS CHECK FOR THIS GROSS LOSS
JRST STF2A5
SKIPN V.RSET
JRST STF2A9
JSP T,ARYSIZ ;GET SIZE OF ARRAY IN WORDS IN TT
TLNN R,200000 ;=> NEGATIVE INDEX
CAIG TT,(R) ;THERE'S PROBABLY A FENCE-POST FOR SX ARRAYS HERE
JRST STF2A5
STF2A9: PUSH FXP,R
EXCH A,(P)
PUSHJ P,EVAL ;EVALUATE THE NEW VALUE
POP P,LISAR
POP FXP,R
JSP T,.STORE
POPI P,1
SETZM LISAR
CSETF5: JRST SETF5
SETF2G: PUSH P,CSETF5 ;"GET" OR "CXR"
HLRZ A,B
HRRZ A,(A) ; "(SETF (GET <arg1> <arg2>) <val>)
HRRZ B,(A)
PUSH P,B
PUSHJ P,EVALCAR ;Eval <arg1>
EXCH A,(P)
PUSHJ P,EVALCAR ;Eval <arg2>
PUSH P,A
HRRZ A,@-3(P)
PUSHJ P,EVALCAR ;Eval <val>
HLRZ T,@-3(P)
HLRZ T,(T)
CAIN T,Q$GET
JRST STF2G2
MOVE C,A
POP P,B
POP P,A
PUSHJ P,RPLACX ;REMEMBER return addr was pushed above
MOVE A,C
POPJ P,
STF2G2: MOVE B,A ; at SETF2G
POP P,C
POP P,A
JRST PUTPROP
EVALCAR: HLRZ A,(A) ;save a couple of instructons! by coming here
JRST EVAL
SETF3: POP P,A ;Can't hack it, so give up and let the
SETZ B, ; B=() ==> For Value
↓CALLF 2,QISTFX ; +INTERNAL-SETF-X expander expand it.
JRST EVAL ; and then do it.
| ;END OF DAMNABLE CUT-OUT OF SETF FSUBR
;;; Standard simple PUSH case (for symbols) is as follows:
; (DEFUN PUSH FEXPR (L)
; (DO ((X L (CDDR X)) (SYM) (VAL))
; ((NULL X) VAL)
; (SETQ SYM (CADR X) VAL (EVAL (CAR X)))
; (SET SYM (CONS VAL (SYMEVAL SYM)))))
;;; Standard simple POP case (for symbols) is as follows:
;(DEFUN POP FEXPR (X)
; (PROG2
; ()
; (COND ((NULL (CDR X)) (CAR (SYMEVAL (CAR X))))
; ('T (SET (CADR X) (CAR (SYMEVAL (CAR X))))))
; (SET (CAR X) (CDR (SYMEVAL (CAR X))))))
;;; Otherwise, we try substituting +INTERNAL-PUSH-X (or +INTERNAL-POP-X)
;;; for the "PUSH" (or "POP"), and let the (autoloadable) macro
;;; expander handle it.
$PUSHER: POP P,A
%WTA TNILER
$PUSH: JSP TT,FWNACK
FA2,,Q$PUSH
PUSH P,A ;SAVA THE ARGUMENT POINTER
PUSHJ P,CADR
JUMPE A,$PUSHER ;SPECIAL-CASE CHECK FOR NIL AND T
CAIN A,TRUTH
JRST $PUSHER
JSP T,SPATOM ;CHECK FOR STANDARD CASE
JRST $PUSH1
HLRZ A,@(P) ;GET THE "VALUE" TO BE PUSHED
PUSHJ P,EVAL ; AND EVALUATE IT
EXCH A,(P) ;SAVE THE RESULT, AND GET THE ARG POINTER
JSP T,%CADR ;GET THE SECOND "ARGUMENT"
PUSH P,A ;SAVE POINTER TO SYMBOL
PUSHJ P,EVSYM ;GET SYMBOL'S VALUE
JFCL ;IF SKIP RETURN USE NEW USER VALUE
MOVE B,-1(P) ;GET THE THING TO BE PUSHED
JSP T,%XCONS ;PUSH ON THE "STACK"
POP P,AR1 ;GET BACK POINTER TO SYMBOL
JSP T,.SET ;STORE BACK THE NEW "STACK" POINTER
POPI P,1
POPJ P,
$POPER: POP P,A
%WTA TNILER
$POP: JSP TT,FWNACK
FA12,,Q$POP
PUSH P,A
PUSHJ P,CDR
JUMPE A,$POP4
PUSHJ P,CAR
JUMPE A,$POPER
CAIN A,TRUTH
JRST $POPER
JSP T,SPATOM
JRST $POP1
$POP4: HLRZ A,@(P) ;GET THE "STACK" POINTER
JUMPE A,$POPER
CAIN A,TRUTH
JRST $POPER
JSP T,SPATOM
JRST $POP1
PUSHJ P,EVAL ;AND GET THE "STACK"
PUSH P,(A) ;SAVE THE 1ST CONS OF THE "STACK" ON P
HRRZ A,@-1(P) ;GET THE PLACE TO POP INTO
JUMPE A,$POP2 ;NOT SPECIFIED, JUST RETURN THE TOP OF "STACK"
HLRZ A,(A)
HLRZ AR1,(P) ;CAR OF STACK IS VALUE BEING POPPED
JSP T,.SET1 ;SET THE CYMBOL INTO WHICH IT IS POPPING
$POP2: HRRZ AR1, P) 3NOU CDR THE "STACK" AND RE-SET INTO STK-@TR
HLRR A,-1@(P)¬
JSP T,.SET1
HLRZ A,(P) ;RETURN TH@
Aπ¬$A∨ ↓)⊃
A9 .@EM)βπ⊗λ~∀∪!=!∩A 0d~∀∪A∨!∀A@X~∀~(~∀I!= bt∪M↔∪!α↓εY7#%!∨1:$∩vE!U'⊂DA¬≥λ@EA∨ DA
β≥(A
A⊃β9 → λ4∀I!+M⊂bt∩A≠∨-∃∩AεYE∪!+0$∩vA'<AS]m=WJAi!JA→∪M [G←⊃KH@W%≥) %9β_[M=↑[0~(∪!∨ ↓ Yα∩$∩vAo!SGPA∃qaC]⊃fASh↓M←dAUf~∀∪M )4AλX∩∩∩lA∧zP$A[KC9f@E
=dA-C1kJD~(∪πβ→1 @dX!εR~∀%∃%'(↓ %β_$∩wC]⊂A -β0AiQJ↓eKgk1h~∀~))≥∪→∃$tA'%1¬∪(↓9πβ≥P@E!+M⊂DA∨H@E!∨@DA)≡↓(Aβ≥⊂A≥∪_¬8~∀~(_~∀~)'+¬)Q_∪')=%
XA % β⊗0A'∪∂9 ~∀~)')∨%∀t∪∃'@A)(Y→/≥βπ,~∀∩@A
αd0Y#')=%
~∀%⊃→%4↓∧XQα$~∀∪!U'⊂A 1∧~∀∪!%%4A∧XQαR4∀∪⊃→I4AαX!αR~∀%!+'⊃(A Y Yβ_∩∩m -β→Uβ)
AM π∨≥⊂Aβ%∂U≠ ≥(↓
∪%'PB~∀∪A+'⊂A@Yα~∃M)∨%
\t∪⊃%I4AαX4bQ R4∀∪' Q5~A→%'β$~(∪!+'!∀A Y∃-≥⊂`$∩w -¬→+β)∀Aβ%%¬2A% → % ≥
A/∪Q⊃∨+(↓⊃∨∨↔%≥∞A∪P~∀∪'-∪!≤A∧Y→∪'¬$∩∩w¬→/β3LAπ⊃
⊗A
∨HA)⊃∪LA∂%∨M&A→∨M&~∀∩↓∃%'(↓')∨%∀j~∀∪M↔∪!≤↓,]%'∃(~∀∩↓∃%'(↓')∨%∀r~∀∪)' A(1β%3'%4∩∩w≥ (A'%5αA∨_Aβ%%¬2A∪≤↓/∨% LA∪≤AQ(~∀∪Q→≥≤AHXd``@``∩∩lz|A≥∃∂β)∪Y
A∪≥⊃ 0~∀$Aπβ∪≤A)(X!$R∩∩m)⊃ %∀O&A!I∨¬β¬12AαA→ ∃π
5!∨'(↓
∨$AM0Aβ%Iβ3&A! %
~(∩@A∃I'(A'Q∨%
j4∃')∨I
rt∪A∨ A 1α~∀∪M+∧A 1$n`VD~∀∪∃M A(X9')∨%∀~∀∪'∃)5~A1∪'β$4∀∪!∨A∀A X4∀~∀~)¬% β,t∪∃'@A)(Y→/≥βπ,∩∩w
M+¬$@ b@\@HR~∀∩@A
αDdXY# % β⊗4∀∪⊃→I4A∧X!αR∩∩m¬↔!(↓≥β≠
4∀∪⊃%I4AαX!αR~∀%∃+≠!∀AαXI %⊗`∩$w≥≡AM π∨≥⊂Aβ%∞z|Aβ1/β3&↓¬% β,~∀∪⊃1%4Aα0QαR∩$w)≡[ % β⊗5∨$[≥=(A'/%)π⊂~(∪!+' A Y∧4∀∪!+M⊃∀A 1 -β_$∩w)⊃%&A∪&↓αAπ%=π⊗BB∧~∀∪!= A Yλ~∀β∃I'(@I % β⊗$∩wα@tA¬% ¬↔ XAλ@zA¬I β↔∪⊂~∀
∀4∃'β∂9 t∪∃M A)(1
/≥β
⊗∩∩w→'+¬$d~∀∩@A
αHXY#'%∂≥ ~(∪!+' A XQ∧R~∀∪!→%4A∧XQαR4∀∪!+M⊂A Y∧~∃'∪≥≥ `t%!+'⊃(A Y!9∂ (~(∪⊃→%hAαXQ∧R~∀∪5∨-&APXQαR4∀∪⊃%I4AαX!αR~∀%∃+≠!8AαY'%∂≥!
4∀∪≠∨Y≥∩Aα0l~∀∪
β∪
APY↓'!Q∧VlQ∧R~∀∩↓β∨∃_↓αX\ZD~∀∪∃U≠!∂
↓αY'∪≥≥!
~(∪⊃→→hAαY'A)∧Vl!αR~∀%'+∧A@Y$n`,b~∀∪∃1π⊂A∧XQ R4∀∪⊃→I4AαX!αR~∀%!+'⊃(A Y Yβ_~∀%!+'⊃(A Y≥U≠¬ ¬@~∀β∃U≠!
A∧Y!∨ E∀~∀∪A∨ A 1(~∀∪!%%∩APY)%+∀~∀∪1
(A(~(∪∃%'PA
β→M
~∀~)'!)∧h~∃∪%@A"XYm_Y
Y1
Y∞Y≥
Q
:4∀∪∃+5 C"AQ(XQβMβ∪∩Aq#8R~)) %≠%≤∩∀_~∃'U¬))_%!%∨∞HXA!%=∂≤XA∃"XA%A→βπα0A%!→¬πλ~∀4∀∩∃!I∨∞bt%'↔∪!∧A$Y1 Zb~∃A%∨∞dh∪≠∨-9∩A$XH~∀βπ¬≠→
APY$~∀$A∃%'PA!%∞De4~∀%⊃%→∩↓(XZb!(R~∀%β λAPY ~∀%'+¬~↓(Y$~(∪≠∨-∀AαXQHR~∀∪5∨- ~↓(Y ~(∪!∨!(A X~(~∃!%≤be4t%≠∨- $AλY#A%∨∞d4∀∪πβ%
A$XH~∀∩A5∨- ∩↓λY#!I∨∞b~(∪∃%'PA/≥β1∨'
~(~∃!%=∂≤t∪¬∨∃∞APY
β→M
~∀∪A∨ A 1α~∃!I∨∂≤bh∪∃+≠A
A(Y
!∨!∀4∀∪⊃%1∩A(X4bQ(R4∀∪β ⊂A Y(4∀∪!∨A∀A X4∀~∃ Dt∪πβ5≤AαYλ∩w'+ $@d@4A!∨∪9) $A% ≥)%)2A!I ∪π¬)
~∀%∃%'(↓)%+
4∀∪∃%M(A
β1'
~∀4∃%!→¬παd∪M↔∨)(↓αY→&4∀∩A∃I'(A%A→πα`4∀∪)→9
A)(1!+$WYε~∀∩↓∃%'(↓%!→π∧b~∀∪!%→~AλXQαR4∀∪!∨A∀A X4∀~∃%A→βπλh∩∩∩∩m'+¬$d@ZA
→∨¬¬∃$Aπ HA∨ A→∪%'(↓β%∞A]∪)⊂AM π∂≥⊂~∀∪'-∨)(A∧Y→&~(∩A∃%M(A%!1πλd~(∪)→≥∀A)(YA+$~∀$A∃%'PA%!→
λb~∃I!→πλLt∪⊃%I~A∧X!αR~∀%!∨!∀↓ X~∀4∃%!→
λdt∪)+≠!
↓αY%!1πλ`∩$vQ%!1βπλA9∪_A
=≡RA∪LAβ→/¬3&Aα↓→∨'&4∀∪'↔%!αA(1)π $4∀∩Aπ¬∪≤A(1#→∪'P∩∩w∪_Aπ $zA≥∪0A∨$A1∪'(X↓)⊃ ≤↓¬∨≠¬=+(~∀$@A∃%M(A%!1πλ`∩$w'∪≥
Aβ%≤A∪&A9∨(A→%'(A∨HA≥∪_4∀∪πβ%≤A(YE'3≠¬=_~∀∩↓)→≥
↓)(Y'd~∀∩@↓∃%'(↓%!→π⊂f∩∩w% A≥∨PAπ $zA'35¬∨_X↓)⊃ ≤↓β≥3)!∪≥∞A≥∨ &~(∪∃%'PA%!→
λ`~∀4∀∪!∂Q≠ A Y_Y7 Yβ_XA¬!!→20A')+→ A∨!∃≤[π∨⊃ λA¬dAπ∨≠A→%:~(_~∀~(~∀I∪9'%(A≥π¬∪∧$∩w∂βI↓β∂
↓π∨→→∃π!∨$↓β≥λA¬→→∨π¬)∪∨≤↓')+
_~∀~∀⊃∪≥'%PA% β⊃ $∩∩m% βλ↓β≥λAI →β)∃λA
+9π)∪∨9&~∀~(I∪≥'I(Aβ%Iβ2∩∩mβ%%βdA!βπ-β∂
~(~∀I∪9'%(A→β'→∨∧∩∩w
¬'→∨β⊂@~∀~(I∪≥'I(A#∪<∩∩w≥∃.A≠+1)∪!→∀A
∪→∀A∩←≡↓
+≥πQ∪∨≥&4∀~∀_~∃'U¬))_%∪≥) I%+!(↓⊃β≥ 1 %&~(~∀∪!≥¬∨(A%≥(~∀4∃∪
≤↓∪!&Yl~∀
∃A∪⊃∨→⊂t∩]'A∪π→$0Y$n`∩∩w/=%λA)<@D]'U' (D↓)≡A)U%≤A∨→ A∪≥Q %%+A(A'3M) ~~)!∪≥¬0p∩]'A∪π $0Y1εZD@∩∩w]≠%λAQ≡@D]M+' (λA)≡AQ+%≤A=≤A∪≥Q %%+A(A'3M) ~~(~∀vVlA≥ .5')3→∀A∪≥)∃%%+!PA)%β9'
$↓)⊗∞$zH4(hQ2N⊗*α&&ε≤X4)@572¬≥H→d$
(@¬$ JXU~¬It¬¬-D ∀rαiX∃≤Zλ→d"αiZ4[∩λZ4-∩RIABLES.
9;; INTERRUPTS NORMALLY ENABLED ARE:
;;9 PARITY ERROR
;;; WRITE INTO READ-ONLY MEMORY
;9; MEMORY PROTEATION VIOLATION
3;; ILLEGAL OPARATION
;;; PDL OVERFLOW
;;; I/O CHANNEL ERROR
;;; RUN TIIE CLOCK
;;; REAL TIME CLOCK
;;; ALSO, FOR THE USELESS SWITCH:
;+; CLI DAVICE INTERRUPT
;;9 SYSTEM GOING DOWN/REVIVED
;;; SYSTEM @EING DEBUGGED
;;; CKNTRMH OF TTY JUST GIVEN BACK TG LISP
9;; (SSTATUS MAR) MAY ALSO ENABLE TH@
A≠¬$A∪≥Q %%+A(~∀]M
A'M≠β$~(~∃'α∀A') 5'⊗zKA∪!β$,K!∪/I≡VK!%≠!,V∃!∪∪→<VK!∪A _VKA∪∪∨ε,K!∪%U≤VK!%%→(~)'αHAM) ≠',zK!∪5β∩VKA∪!β$,K!∪/I≡VK!%≠!,V∃!∪∪→<VK!∪A _VKA∪∪∨ε,K!∪%U≤VK!%%→(~)∪
≤AU' → M&XA'Q ≠'⊗u') ≠M⊗VK!% /≤V∃!∪ ¬≤VK!∪¬)2~∃⊃¬∂≠',{') 5'⊗Zx∃!∪!βHVK!∪5!,VKA∪∪→≡,K!∪βQ2|~∀4∀vvv↓β→_A$←≡Aπ!β≥≥ 1&Aβ%∀A ≥β → λX↓β≥λA¬→_A∃=∧Aπ⊃¬≥≥ →LA
∨$↓+' →∃'&A']∪)π⊂8~∀~∃M) ≠&Hzzbn\nnn~)∪
≤A)∨¬#∪<XA')⊃≠&dzu') ≠LdVxf\nPX|4∃ ¬∂5&dz{M) ≠&H~∀
∀4∃
%≥αA∪9)∂% ↓⊃β≥ 1 $W!%%#εz@Y∪
↓%$z`Y⊃ b{'Q ≠'⊗,K!∪≠¬$ZxKA∪! _,K!∪!¬$VK!%/%≡V∃!∪≠!XVK!∪%→≡|Y⊃ d{πQ ≠&d4∀∪!∪I#ε~∀%∪
!∪H~∀β _b~∀∪⊃ d~∀%⊃β≥ 1 $
∃Q %≠∪8~∀4Ph*&:%2⊗
hL"⎇Y-~a2&:%α∩0$KZBα1∧2>Iα¬*N"&t9α&:$*JJV¬!αNR,2_4(HH$%n ~Mα⊃bαI1α2αεJ∃¬~εZ⊗ αε2>t9α↑&$Aα>RD*Iα∞∃*⊂4λhP4*N
$&&u"≡JA∧j⊗&⊗∃⊃2B&∃
¬u⊗∧J6ε%X*B&B
⊃-⊗BM:J=--α&6B2Y⊗B&Lb=2∩3 vNR$jN---α&6ε∩i⊗B&∧"0%nl*6>JJαε:⊃∧zB∞>$)α⊗J∀zJL4U~¬∀$LJ:R≡∃↓α6⊗l*JI2∧JJF
j*B&B
⊃-⊗BM:J=--α&6B2Y⊗B&Lb="∩3 vNR$jN---α&6ε∩i⊗B&∧"0%nl*6>JJαε:⊃∧zB∞>$)α⊗J∀zJL4Ph*N¬ H&&:$:JAαl
&&:"bB&J →u⊗BMα∩0$KZNε&bα6ε&bα&*R-∩JVB h($&LrR≡JααB∩2⎇12B&∃
u⊗∧JB∩0HIfB∩bα>Z⊗∀22>\hP$&&u"≡JA∧J>∞⊗∃⊃2B&∃
u⊗∧J&> HIn%>zα∞"εtr⊗1α-∩J>HhR&~9¬*N⊗2-~M0&LrR≡Jαα∞2&LrQ2BM∩F
u-α&∞2HH%n∞dIα&:$*JJV¬ 4*&4qαVN,b⊗NM`J&:R=∩AαR%∩&:Qeα&JF≠i⊗B&
"d$%]"Reα∀*RVJt*⊃αRzα*>λhR&~9¬*N⊗2-~M0&LrR≡JααNfNLrQ2BM∩F
u-α&∩↑rY⊗B&$∩≤%n≥JMα∩⎇:9α>∩α
⊗&t9α∩⊗∃*≡≡⊗ h*&~rα*>
J50&LrR≡Jαα*>
LrQ2&5α&Iv[→]]1eh$%nLr~⊗JLzIαB∀z∞⊗∩-∩⊗L4PH&&:$:JAα≤B2&:"b&~BM⊃uE];9]\$KZ%>=∧~"ε:t*1α&u"⊗JJ-αRL4U"Rf∩3 uuiriL$%u~⊗∃α,J:Q@hRRRf$1IuuRq5H4TJ~9α-~⊗2⊗≥→0&&u"≡JA∧jεJ&u!2B&∃
u⊗∧J6εHHIn6ε∩α
J⊗ X4($LJ:R≡∃↓αJVt~2>∞ZbB&J →u⊗BM∩V8$KZJV:$J6∃α bεJ6≤b>∞,hP$&&u"≡JA¬∩⊗ε2≤b>∞-eα&JF≠i⊗B&∀bP$%]∩⊗ε1¬"&6∃∧
2εJl~2>∞Xh(4*dJ:RZ,→uuirj&:R4* %nd*:≡RBα>→αLrR⊗J∃*BQα4*∞R>⊂h(4)[Ymα:⎇"∃αRD)α⊗~4*∞Qα|1α"ε4J:≥α$B∃αεd
J6∞dz∞.M∧bεNQPh)mmXJ&>
∧
:⊃α≤Bε::,aα&:$*JJV¬!α"ε¬α⊗9α4JJNQbα
VQ¬:"⊗8hQmmlM""∃α∧J>9αD
BB⊗u→α&:≤J∩∃α,J:QA¬""∃α bεJ6≤b>∞-∧:⊗RLhQmmlLJRMα%*J9αLj6⊗∩L
R⊗2Jq↓α~-∩R"⊗∀j>J∃bαR"∃¬∩⊗ε1¬"&6∀hQmmlL~2>∞Zα≡⊗R~αN2&<BR2e∧B&≡"-⊃αBJ,~⊗∩⊗t~∃84Uh$%n,r⊃α>2α&~9∧JRL4P04(hR&~9∧!IA2Xh)mmZαR>B~iIAαLrR⊗J∃*BQαD
:∩2-⊂4)m[Yα&:$*JJV¬"Mα:|jJε2eIα⊗: ∩2⊗⊃∧
J∃hhQmmlMα∩1α⎇2⊗J~dz\4)[Yl&&db⊗≡εbα&:N%∩V∞RLz84)[Yl&&db⊗≡εbα6⊗6⎇∩eαJ,
⊂4)[Yl&&db⊗≡εbα6⊗6⎇∩eα↑∀JR∀4SYml&tz:⊗bM~Rε:"αBε≡*αJ⊗~-∩⊗:∞(h)mmXJZεJLzVMα≤BεJε≥"⊗JM∧*:ε
d*⊃α~⎇⊃α&:$*JJV¬"Mh4SYml$Mr¬1αt⊃1αz"aαz∃bαz→1¬r≥1αu11αz:aαzabαzh4Ph(4)[Ymα∞D
::⊗bαεNNL::6⊗u"Mh4SYml%
IαB∩bα>X4SYml%∩Iα&2d*≡ε1∧J:NR∃*∞R&|q1α&daα6⊗jαI↓→¬91α>$B⊗Iα≥J:
αLrR⊗J∃*BRLhQmmlK→%αε≥J:∞"∀z:>V~α&:R-∩JVB%_4(4T"&N6≤Yuu@HH%n≡,r⊗Jε$)α&6∧zJRεu!α&:$*JJV¬"Mα6
~,4*M∩Aα~|y12mtJ∞B>2a:&∞Lb%1:L~&J⊃br&∞&=⊃1:&≤rbBthQ↓↓↓∧"&N6≤Yuv∩M~6N-[aF⎇q≠)96~|yyx4U"⊗J6Lp4(4U~R∩6≤Yuv∩M~6N,HH%n≡,r⊗Jε$)αNR r∩εJ"α&:R-∩JVB"α6εNXh*&Jαα~>=bbm:&≤"ε⊗thQ↓↓↓¬~R∩6≤YuvN$"6N-[aF⎇q≠)96~|yyx4U"⊗J6Lp4*N$"6N-kjNR∩m~--q;9AAAαa1AA;9]]xKZε2Nzα&:∞e*∩∃α b1αV≤*Iαε≥~&≡: ∩2∃α≤Bε::,bL4*$∩≡6N[ivNR$jN,$HIn~>∩α:>]bα6εN]→αεJ*α⊗FVM2ε2⊗u 4(4SZ∞"εtr⊗1α$
2∃αBεNNL::Mα
αBJ&⎇∩&Re∧b⊗J⊗bαε:⊃∧Bε:∩d*Iαε%⊃αR=∧*ε∞!∧~"ε:t*1$4T~":R ⊃h4*∀*B⊗ε"↓Y1↓~a2&:$
NM-brJB∞u!)MyIn~&∃~Q↓Y∧
NN&<rε
2*α&:R-∩JVB%_4(%α↓⎇↓Aβy↓@$KZεJ&$B6⊗RL→α>Z-∩~2>=_4(%
a1∩B$b>X$KZB2∩⎇04(%α↓⎇↓AH$%n*j=6→∧
:⊃α$
R¬6-∩J>HhP%A↓z↓A↓⎇β$%n∀*N⊗J4*⊃αRzα∩ε hP%I1dJ:R&dx$%nLb2⊗≡ aα&:≥"JV∞$J684PII12LrR&J H%n&db⊗≡εbα6⊗6⎇∩eαJ,
⊂4λK⊃12&u"&NHHIf&2d*≡ε1∧j⊗6>∃Iα↑JM"∀4(K↓↓⎇↓α↓⎇↓Aβy↓@$KZJ⊗N-∩Z,ED∧ tDπphP⊗%BdLjIeEα↓⊃∪LTyeT-D~:D uD
∧ <QQ K⊃⊃∪@4⊂r⊂)iQ3λε&kH∪ zq4h!QTQ4λX5λ⊂i→U∀vEVKλ eE∩3Uλ~tjoεekTTλ9U∂JF4∞tQ)X23R)hh⊂4j91sP()⊃(∩)j⊃4TJZ∃∀c!)1SH¬e0r∪JH0K,feKλ∃h~SH⊗jzSsQd U30HZH⊃3JJR14d 3H⊂i U⊂0G{#"C!'s⊃5HYλ∃⊂()⊃( $
r⊃4HT∃∪h
:∪tQ$
⊂h⊃IzH∩3JH4TU*
λ⊂5∧λ00r∧
∩(∪λZQ3β!)⊃5Uλ_NB,¬E∩3U
λl#"A⊗ ∩)j∀⊂lAQB, ¬I3U∀λ6c"C!!"Nng4∃∪t
5,Lλ →U⊃4J*4∃λ λ3Q∪ →Qh∀Iz5∩3HZc"C!'nnhλ83∪⊃(D⊂5λ
:⊂4U
Zλ∃∪d
Q23I~∩03 ≠Q(∃ λ(∩3JH4TU*
λ∀v*:⊃3#!(3PR)J∞B3)zQ2(ε∃ QR
9⊃B"'903R*
3⊂5λT∪u4J83∃Q*1"B3)zQ( EKs⊃5JH0K λ9∪U⊂(+".r)j⊃4TJZ∃λ∀λ4∀u∪j(1q(
H0K λ9⊂3SHYλ∪∪h4∃⊂0AQB4r*!"".j:⊃0r(k(∃∩λT∃⊂0IH4c"A~q5⊗D
α"!↔s∪sj∧∪uQ*$⊂3Q∧λ4tr(yH∃∃ ∀∩3UλZTU4
D⊂r⊂)iQ3∀aQQ3PI→LNB*9r4⊃dε+⊂r)j⊂0J
E".u 4h⊃)j∀V(
Zq1λλitH∃
K(∩3JH4TU*
∂c"A∀∩TTjD⊃3PI→L""'9St⊃%D⊃sh yC"B)YuTtdε"""'8r⊂4H_u⊃4Dλsq4d 3H∪λXUλ∩λ→⊃C"A→∀TR$ε+
∃¬⊃".piλ3SQ)D∩3H
)1r∃∧ ⊂3⊃AQB0p)→λ∃ εa".tHY∪puλ→3sH h0q4j84V/aQB(⊂(H∩( %FM K&a".v(Zkλ∪(→q(∀HX3λ⊂iλ3SQ)D∪U3((4C"A_5∩"!⊃.p4j91sH
H4S2)h3λ∩)j⊃4TJZ∃λ⊂iλ3SQ)A"Q3H)3L.A_p21hT∃ ⊂i→U∀vEV".q yQ/c!!(⊂3i((∃ λYPR3F!"B3)zQ2(ε∃ QR
9⊃B"'83P0IH(⊂4
St∀I_5⊃(λ9⊂3SHY∀c"A→3uQ$εK⊗tjH∪4rkQ".q)h0S⊃$
u⊂3HH4Qλ →U⊃4J*4∃∀aQB33jh3( EI304i1".u 4h∩*4⊂u4J(3Uλ →U⊃4J*4∃λ X4rc!!33uHY( K y304i1".u 4h∩*4⊂3∀it∃∩⊃$ s⊃ )X4rc!!020aQB33jh2( %EQR∀iHB".hYP0SλT∪u4D 3U⊃**U4∃∧
v4uλY#"Vλ:∀∀SaQB12*!"B4hZ⊗PHε∃ B"'8∪sIjD∪⊃0*h(∀P)h∪s3HZth∩)d∀∀SjH0u⊃(D⊂0taQSSt
)c"B* t∩H
¬β"C!'tQ1)h0S⊃*4∩3UλZTU4
Jh⊂1JH4H∃ λ6(∩λ~Q(⊂HX3H⊃ ~p0SλXλ⊂V$λ⊂3∩)jλ∪tDλ∩4r)jβ"THX23Uπ!4∃4i∧∀ !QB4∃*9λ∀ ε!"V⊂jJ∀Sc!!03thT∩3Uλ→∪α"'8∩4p()⊃1λλ→∪λ∩)j∀oc!!(∀ri~⊂( EIr30*9b".iikλ∃*8(∪sλD∩3UλZTU4
D∪04i1"B(∧
rr4λ∀ K∩)X4rb!↔q3∀hT∃4q$λu4THYUλ∪(~rc"A∀λλ∪)zQ3(ε%∩30*9b.u 4h∩*4∪Sud
∩⊃(λ:4TQ)jλ∪0*9c"B)YuQ2$ε+ QI
s⊃B!↔tQ1)h0S⊃$ 3U⊃**U4∃
4⊃StD u4ThY⊃C"A_20c!!4∪t∧
C!!4∪t∧
#!)St∀Iq"B4 z∩H∀¬A"C"G:∩∩4d
Su5 →Q(⊃ ~p0SλZh⊂3 D∩3UλZTU4
Jh⊃TIy(∪ph:4R3Hq"Nu λ(⊃Sλ_h∩3JH3∪λ ~h∀q*D∀p6)→Qh∃ t∃⊃3 D∃∩⊃$
Q+1)h0S⊃$
Su5 →Q(∃ t∀Q4jItQ#!'h∩3JH4TU*
∀h⊃J)s(∩)X4rh
(5∩⊃*$∃∩⊂)d∪r3(~rc"Jx4SH :∩∩3I4⊂0SjZλ∃4i→Qh hI4IhλitH⊃λ→∩3U Q"Q⊂)I3U∞A~∃4r∧
#!!4∃4i∧∀ AQV⊂u
Sc"A~∩4u zβ"B* tλ∀¬FC"B* tλ∀¬F#"SIz∀Sc!!4∪t $∀ β!!"Nq ~p0SλT⊂3∪∧λU5λ →4∪tJH3Uλ →U⊃4J*4∃∀aQNr3(~rh∩*4∪3uHXλ∃∪d r30*9kλ⊂)hλ∩3(~rh∩*4∀q5
Zλ∃∪d Q5hλ:4TQ)jλ∪0*9h∃P)J1#"HI4r3JGB4∃*9λ∀ ε⊃".uhT∃r3 D∪Q1(D∃∃sd
stRi→Qh⊂(:c"B*
4rλ
¬ C"Kλu∀∀Iq"B3)zQ( EI304i1".qhZλ⊂u**Q3U∧ 3U⊃**U4∃∧ 04raQ@33jh3( EIr30*9b".jZ⊃⊂5λT∪s⊃∧ 04raQB03HD K⊗hI4s4i;"".iyS⊗(λ→∪∪ud 34∪j*⊂3U∧ 3U⊃**S
MOREM2,IMASK ;NEW MASK
MOVEI 1,.FHSLF
↓AIC ↓ ;MAKE SURE THE IMPORTANT ILTERRUPTS ARE ON
SEPCA 2,
DIC ;BUT ONLY THE IMPORTANT INTERRUPTS
POP P,2
POP P,1
NOPRO
POPJ P,
;;; DISMISS AN INTERRUPT
DSMINT:
XCTPRO
AOS DSMSAV ;@OINT TO NEXT FREE LOCATION (A SMALL STACK)
MOVEM 1,@DSMSAV ;SAVE AC 1
MOVEI 1,.FHSLF ;PURN OFF SYSTEM INTS WHILE MUNGING INTPDL
DIR
MOVE 1,INTPDL ;NOW UNDO INTPDL
POP 1,F
POP 1,R
POP 1,D
POP 1,@-1(1) ;RESTORE RETUBN PC
SUB 1(R70+1 ;THROW AWAY REDURN PC PGINTER
POP 1,IMASK ;RESTORE OLD IMASK
SUB 1,R70+2
MOVEM 1,INTPDL
MOVEI 1,.FHSLF
↓EIR ;NOW ALLOW INTERRUPTS
↓MOVEI 1,.FHSLF
AOS DSMSAV ;SAVE AC 2 ON TOP OF STACK
MOVEM 2,@DSMSAV
MOVE 2,IMASK ;TELL TOPS-20 ABOUT OLD IMASK
AIC
MOVE 2,@DSMSAV ;BESTORE AC'S
SOS DSMSAV
MOVE 1,@DSMSAV
SOS DSMSAV
NOPRO
DE@RK ;THEN DISMISS THE CURRENT INTERRUPT
;;; INTPDL BUILDAR: RETURNS INTPDL IH A 0Aβππ∃!)&AAεA!∨%≥) $↓∨⊂→α4b@4
LrRNVβP4*b≥"BJ<HH$%nt*⊗⊃α¬∩>R⊗≥"&>9∧
Mα↑*α↑&2bαVN∃∧jεJ.,!αε∞_h(&6⎇2⊗5↓
bNVB≤
X$%]~εZ∃∧r⊗⊗∩,!αJ⊗<JNR⊗⊂h(&6⎇2⊗%↓λa:~"≤b_$%]"VJ9∧z~→α$B∃αεu"⊗JJ-αQαNM~R⊗5¬:"&2*αR>V≤B&:≤hP&∩&⊂H$%m∧J:RB$`4(&lzZ∃↓
b&*R∧"04(MαVN!β 2:&`H%n&¬~↑⊃E∧
:⊃αMαN↑⊃⊂h(&B-~!↓Edr&04PJBVNB↓E2&l
N,$KZ&&ε≤YαVB|qα⊗:%∩d4(MαVN!β 2_$KZNεZ*αR"∃¬α
αB|J:R⊗⊂h(&"∃∩jM↓C $$%\∩VQα|r2eα∀@4(&¬*N!↓
a"→$HInε:"αNεZ*αR"∃¬α 4(MαVN!β 2⊂$KZNεZ*αBJ⊗≤*JZ⊗"αε∞LhP&BV≤A↓E2⊂h(&"e∩jMα0H$%n∀Aα:>:α"εM∧
∩Iα|1α_4PJBVNB↓E1"2H$%n≤
Z⊗M∧04(&lzZ∃α2aD$%\~>Be∧z→α&u"B∩⊃¬"=α_hP&6>4*5α→dJ:RB$`$%n≤
Z∃αLrRB∩`h(&6⎇2⊗%↓λa:~"≤b_$%]∩⊗⊗εt∩2∃αLrR⊗J∃*BRLhP&⊗&⊂h(&6⎇2∃↓Ee~VBN
04*:⎇αJ<4PJ*JN"↓"Q$HInJ⊗%*J9α$yα∞εdb⊗H4Ph(4)[YeαRD)αε∞%*ε1αLrR⊗J∃*BQαD
:∩2-∩L4(hQnB∩bα6Z⊗∀22>\hQ∩B∩dzQh&lzR⊗5¬!2B∩e~ZP$KZNεZ*αQαNzαR"ε"α↑∃αD
Z∃α qαε
¬"=αV≤(4(&lzZ∃α"b&:R∧"0$%\2V∩≡*α&:R∧"1αN$
∞-α5∩ε6∀hP&BV≤AαQ2tJ0$%\JBN↑# αε:"α&BN<!IαVu*N⊗⊂hP&BV≤AαQ2tJ04(MαVN!¬!2&6
~,$%]~εZ∃∧J6εNZαVB>pα⊗*R∃H4(&¬*N!α"b2⊗Z$
λ$%]∩!α&~α&:R-∩JVB"αB
α "I1αααε:⊃αA%α~L*2∩M∧z~_4PJBVNBαQ2αd*ZRε⊂H%nN
2∃αB_h(&B-~!αQd 4(&¬*N!α"bH4(MαVN!¬!2_∀PJ6>Z,iαQ∩LrRB∩`H%nNαIu∀* hU*∧→jE∧$βλ∀ y3U⊃*!"B3)zQ(∃¬J⊃∪∀jjα".j(4u∪j((⊂0d
β"B)*Tuλ
λ⊃∪uA⊃.q∩λYH∀∀Ixq4td
⊃∪λ zC"C!'nnh
R3tI~⊗(∪λZQ3λε$∩3UλZTU4
D∩⊂3HI⊃4TaQA"Ni→U⊃4J*4∃λλ_U⊃4D Q5s ∀⊂tQ(~⊃1λ
λ1q#!)3U∪K
∞B3)zQ3(
E∪∃LJ:Uβ"A→3uQ$
⊂∪λZU⊂0E6#"B) ∀VH
E
∃
!⊃.qq*D∃∩⊃$ 3Tu
*0u∩)yH∃∩λ~λ⊂p*Zq1λ
I⊃(⊃j)11C!!5∀VD
εε mb!↔p3V$ 3Q⊃+∧∪tH →Q∩4HXu∩3id∩4h yc"B(821(
E
∀q*I3*"!↔tt⊃(903λ
x6(∃ t⊂tQ(~⊃(⊂$
⊂1q%D∀shλ→∪λ∩*4∪rc!!(∩TJ:λ∩3JI4∃B!↔su∩λZUr4hT∩4hλ(1λ∪HZtc"A→3uQ$
∪∃F*uUα!↔q3∀hT∀Q4jItQ(
A"B1λXTRb!⊃.p3HD∀Q5
ZSH∩)ju⊂3JI⊗#"AQNr3 H1p3∧ 133j+(∀Q(_β"R)j∩4Qπ!33uHY(∃ JLTuJA".u
(05λ →∪⊃1h→λ∪1)YtV(
(01λλ~h∪4
a"C"G9⊃4Q$ sH∪(Y3tV$
∀SuλXu∩3id∃R3iH5∩3ieλ∃λ
85Q1∧ sH⊃K
β"R)j∪4∃G!33uHY(∃ ∧Z∩34
a".u
ZSH∩)j∪h⊂)d∪4∃AQ@2TJ:λ∩3JI14B!↔p3Q∧
∀Q0*D∪∩2hT∪u∩λZH∪1)YtV(λZTStJ1"C"G93∪⊃(x3λ∪(Y3tV$
tR5λQ"R3JI5tNA→3uQ)T∃ ∪
FTuU↓Q@33jJr(∃¬E 4∩*ZSj"':tR5λT∩3U T∀Q0(E3sS ∀∪13)zV#"A→TTu∧ 3U∪(ZC"C!'r3∪λXp3λ zβ"R)j∩3∪g!33uHY(∃ JLTuJA"Nng∀∀t⊃(903λλ9⊃0rdλStHλH3⊂r∧
v4uλY(⊂p)Iλ⊃Sj$∃⊃3HXp14d
∩⊂5∧λ∪sIjD∩⊂5HT∩5β!'nnhλ854q$
rr4∧
Q1∃*)C"KJ81(∀JXL0l!QB4ri~∪H∃λYQ6∀↓⊃.p(
H3Q6πq"B( *Tuλ →R3∪f⊃".sIz⊃+λ ih∀tλXr03∧λp4q!QB2∀J+H∃ →U∀⊂f!".tλ5l(∪hd∩3UλZTU4
A"B3)zQ(∃¬E,*∃¬⊃".qhZλ⊂0jJ03λ →∪⊃1h→λ∩3J:∀U0jI3sC!!0p3(T∃ ⊗hH3⊂r Q".u λ(⊃⊃)Hrλ∩J;4oc!!(∩TJ:λ∩3I→∪l"!↔sStλUλ⊂( H1r5 →05⊃$λ4TSj$∃∩⊃)a"B3)zQ2(
E b"'_p54hT⊂(∀HZ∃0SD
∪h∩J;4jm∧¬∪SsEX∩4t H6(∃
K*#"A_3th →U∀⊂f!".q)Jq(⊂h~4q(λ∀β"B)YuQ(
E∪∃LJ:Uα"':Q4u zQ(∃↓QB1⊃(*Rb"!↔u∩⊃)d∀Q5
ZSH∃ t∪02)i∩3Q!QC"R)i3∪l'!33uHY(∃ ∧Z∩23 q".r)I⊃1p)D∪t⊃*(5∩3ia"C"G8ss3)yH∪1)YtV(λZTStD ⊂3Q H4Kλ
D∩4h
4r⊃(D∪sHλk∀λ⊂)hλ⊂sij⊂23J4∃∩⊃$λ4TSj$⊂R5↓QNqU(Hq(∩)j∀⊃∪∧λ3Qλ *Tuλ xQH∃ t∪13(ZTC"I→U∪1*'B33jh3(⊃EI∃LTjhB".j85Q(λd∩3H 9SusD
∪⊂0hQ"B3)zQ3(
E∪∃LJ: B"'83∀sd
p5Q$λS⊂1j1"B3)zQ(⊃EKs∃LJ:QK →U∀⊂f+".uiλ4Q(λd∩4k¬Jr⊃4HT∀⊂h ~c"B)*tλ∃¬I3Q∀jZα".j85∃4∧ 3U∀λI λ∀HZ∃4SD 3U∀λIλ∩3DλC"B)YuQ(
E∪∃LJ: B"'8q5λλ(0rhλi⊂1hλ)5∀c!!33uHY(∃ ~∀uqε∃⊃J"':u∪tHT∪13)zV(⊃**StHλ 5∀c!!33uHT∃ ∪
fTuU↓⊃.tQ*:∪tQ$λ0u∃(→λ⊂sij⊃3U
4∪qH
A"B2J*uλ∪(Y14TA⊃.u∩λYH∀∀Ixq4td
∩⊃( X33tK∀⊃4TIzC"C!'nnhλ~tr1ih0S⊃$ 3U⊃**U4∃∧ ⊂3Q H4C"I→U⊂4j7C"THZ⊃05∧λr3U
;K⊗c!!33uHY(∃ JLtuJA".th~Q(⊂(4∃β"A→3uQ)∀∃ J*⊂sU↓⊃.r3HH6λ∩)j∪h⊂i→U⊂0AQB2TJ:λ⊂4j93L"!↔u∩⊃)d∃4q$λss3)yH⊂shH#"W!QP4ti→L.B*9r4∪Dλr3Uλ_J∃
!⊃.p4j91sQ(D⊂r⊂)iQ3∂aQB(∩J*uλ⊂*:tQ5↓⊃.sSjλ+λ∀H→Q∪s$ 3U⊃**U4∃π4∩U4jD∀Q5
ZSC"A~rr4λt⊂r3JH0J∃¬⊃".ih9⊂3SHY h∩)j⊃4TJZ∃λ
λ∀⊂r⊂*(0u⊃*'j#"A∀∩⊂3
A"".iikλ∀iy1(∪jI⊃4H
K4⊃+∧λU5λ isQ(
:4∀∪j*⊃1λ _5 KEa"B3)zQ3(λe∪∃Lj:QC"A→3uQ$λK⊗s
ftuQEE∩3U
λlw#!!33uHY(∃ JLtuε!".th~Q(∩)j⊃4TJZ∃λ∃λ_S⊃( →Q⊃6↓QB2Tj∧∃ ∩)j∀u4↓⊃.tq*J4λ∩)j∀⊃∪↓QB33jh(∃ JLtuε!"B2
*VH∃¬Hr3Uλ_J∃
!↔qq5∧
∩⊃( →U⊃4J*4∃λλ9⊂4P(:⊃4C!!5∀Sd
εε α!↔qS⊂(t⊂4h →U⊃4Ih3β"A→3uQ)T∃ ∩*
uq EλJ".j:∪tQ$ sH∩)j∀⊃∪↓QB33jh(∃ JLtuJA".tHZu∪tHT∪tR(y3sP)D⊂ssJH3U∀d qH∃↓QB2TJ:λ⊂r i3Uα!↔u∩⊃)d∀∀Sh84th
I⊃(⊂iλ3SQ)D∩3UλZTU4
A"C"H~ttQ*GB33jh(∃ JLtuJA".tHZu∪tHT∪tR(y3sP)D⊂ssJH3U∀d qH∃↓QB1⊃(
Rb"!↔u∩⊃)d∀Q5
ZSH∃ t∪02)d∀∀ShzP3#!+"".hYQλ∩(iH⊃ F↓"@↓A"C"I_SH∀h→3 ⊗aQNtp)→λ∪Q*y3h∩)j⊃4TJZ∃λ⊂ix⊃#"AQNpp)I⊃1λ
Ih∀Q)→R5∩(→∩6Q$
∩⊃( →U⊃4J*4∃λ
;4u⊃)Q"Q3H)3U∞A→3uQ)∀∃ ∩)j∀T∃↓⊃.qSλ_tk →U⊃4J*4∃λ Ipp5 →sC"A→3uQ)T∃ I(P4∀A⊃.s∪h85∩3id∀sh YsR5 zH∩sIztc"A~q5⊗IT∩3Uλ→∪α"'8∩1λλ∀ q⊂)I3U d ⊂4u∧¬⊂3∪∧ 3U∀dλ4Q( X4rq(E#"B*85∪pD
∀Q(Y3Uα!↔p3∪∧ 3U⊃**U4∃
4∩3PiJ1∩3Ht∀Q1)j⊃4C!!4q5 y(∀Q(YStα!↔pU5∧ 54u∧
q5λλ)u∩λi⊂1taQB25i94rh
A".p)Iλ⊃q*D∃4h z5λ∪hd∩5p)~β"B)→U∪4i4∃α"'83∪λλ~Q(∪(~rq1∧ sC"A→3uQ$
⊗tjH∪4rkQ".q)h0S⊃$
u⊂3HH4Qλ →U⊃4J*4∃∀aQB33jh3(∃¬I304i1".u 4h∩*4⊂u4J(3Uλ →U⊃4J*4∃λ X4rc!!33uHY(∃ y304i1".u 4h∩*4⊂3∀it∃∩⊃$ s⊃ )X4rc!!23UλYPH∃¬A".uλY∪λ∪jλ4P5 →Qh∀k~u⊃3$
r∩0i∧∩3U
4∃∪hλx3Q4H~⊃#"A→3uQ)∀∃ ∀HX5∀T↓⊃.tQ(YU⊃4D
∀P4∧λ1∀C!!33uHY(∃ ¬iPTQ)a".p)I∪uh
(13UλZH⊂4d 103J4∪qH →ph∩)j⊃4TJZ∃β"A~∪t∩D
β"AQNtQ(YP0SλZh∩3JH4TU*
∀h⊂(j⊃4H
I⊃6( λ5Q(λ(13HλI4p0IH1λ⊂K∀⊃⊂3 →Uλ∪j$⊃∩4i→Uβ"J(023JGB4∃*9λ⊃V
¬∃β"A_3tq$ 3U⊂)Iα".hI4p0IH1λ⊂)Iλ∩3JJoc"A∀∀rr*λ(∃ y304i1".sIuλ∃4hT∪s⊃∧ 3U⊃**U4∃∧ 04raQB(λ
9r4⊂$
∩3(~rb"'83∀q$
4q(λ:4TQ)jλ∪0*9c"B$∧λ∪3jh3(∃¬I304i1.u∩ ~h∩4d Suh
I⊃(⊂jZTQ3JD∪04i1"B2)j∪4rd
α".jI⊃3H
YS04i4⊂stJ(0uλ
85λ∪hd∩3UλZTU4
Jc"B*9r4⊃d
Q12)jβ"B$ TTu∧
Q02)f#"B)YuQ2$
⊂t z∩C"A→3uQ)T∃ I(St⊂aQB4∪j∧⊃V∀¬Jβ"B)*Tuλ
(15∀F⊃".qJX⊃q(λ∀∀Q1)j⊃4H _H∪sHT∃p4d
Q45(Zu⊃1↓QTQ0)→L.B* tλ⊃K
∃β!!4q5 y(∀Q(Y3Uβ!!4∪t $∀ β!!"Nq ~p0SλT⊂3∪∧λU5λ →4∪tJH3Uλ →U⊃4J*4∃∀aQNr3(~rh∩*4∪3uHXλ∃∪d r30*9kλ⊂)hλ∩3(~rh∩*4∀q5
Zλ∃∪d Q5hλ:4TQ)jλ∪0*9h∃P)J1#"HI4r3JGB4∃*9λ⊃V
¬∃α"':q(∃i→∪λ∪HX1λ⊂$
stRi→Qh⊂(1"B3)zQ(∃¬I304i1".qhZλ⊂u**Q3U∧ 3U⊃**U4∃∧ 04raQB33jh3(∃¬Ir30*9b".jZ⊃⊂5λT∪s⊃∧ 04raQB03HHs(∃¬Kr3U
λ4W∩)j∀∪uKI3U∩)I7∩3JIV∪7$πssS ∀⊂3∪ zh∃∩λZq(∩)j⊃4TJZ∃∀c!!33uHY(∃ →04ra⊃.sQ*t∪04i1"B2)j∪4rd
α".jH3∪λ z⊃4P*ISYSTEM
SETZM REEINT ;ALSO DISALLOW REENTERS
POP FXP,T
POPJ P,
;THIS ROUTINE DISABLES ALL INTERRUPTS FROM OCCURING
;THE FLAG INTALL IS SET SAYING TO TELL THE RE-ENABLE ROUTINE TO RESTORE
; INTERRUPTS FROM IMASK RATHER THAN OIMASK
DALINT: PISTOP
POPJ P,
;HERE TO PROCESS AN INTERRUPT
;OPERATING SYSTEM JUMPS TO HERE WITH ALL ACS SAVED AND SET UP WITH INTERRUPT
;STATUS; THE OBJECT IS TO SAVE INTERRUPT DEPENDANT DATA AND THEN REENABLE
;THE INTERRUPT SYSTEM AS SOON AS POSSIBLE....NOTE THAT THIS MUST DISABLE
;INTERRUPTS DEPENDING UPON WHICH ONE WAS GENERATED.
;--INTERRUPT-- --DISABLES--
;MEMORY ERROR ALL EXCEPT PDL OV
;<ESC>I <ESC>I AND REENTER
;PDL OV ALL EXCEPT MEMORY ERROR AND PDL OV
;CLOCK CLOCK
INTRPT: MOVE A,INTPDL ;DON'T WORRY ABOUT SPACEWAR BUTTONS
SETZM REENOP ;NO ↑C/REENTER TRAPS NOW
MOVE B,.JBCNI ;GET INTERRUPT
PUSH A,B ;SAVE INTERRUPT CONDITIONS
PUSH A,10 ;SAVE ARGUMENT TO INTERRUPT (FOR <ESC>I)
PUSH A,IMASK ;DEFERRED INTERRUPT MASK CURRENTLY ACTIVE
JFFO B,.+1 ;GET INTERRUPT NUMBER INTO AC B+1
PUSH A,B+1 ;STORE THIS ON INTPDL
PUSH A,.JBTPC ;SAVE ADR INTERRUPT EMANATES FROM
PUSH A,NIL ;SAVE DUMMY WORDS TO HOLD ACS D, R, F
PUSH A,NIL
PUSH A,NIL
MOVEM A,INTPDL ;THIS IS NEW INTERRUPT PDL POINTER
UWAIT ;UWAIT WILL RESTORE USER AC'S
EXCH F,INTPDL ;SAVE F, GET POINTER TO INTPDL
MOVEM D,IPSD(F) ;SAVE D
MOVEM R,IPSR(F) ;SAVE R
MOVEI R,(F) ;COPY INTPDL INTO R
EXCH F,INTPDL ;RESTORE STATE OF F AND INTPDL
MOVEM F,IPSF(R) ;THEN SAVE F
MOVE F,IPSDF2(R) ;GET BIT NUMBER
MOVE R,SAIIMS(F) ;THIS WILL BE NEW IMASK (F HAS INT NUMBER)
MOVEM R,IMASK
INTMSK R
DEBREAK ;NOW GO TO USER LEVEL BUT NOT TO USER PROGRAM
JRST @SAIDSP(F) ;DISPATCH ON INTERRUPT INDEX
;MAIL INTERRUPT
MAIINT: JSP R,FNYINT
UIFSMI,,V.SMS
;DISMISS AN INTERRUPT
DSMINT: PUSH FXP,T
MOVE T,INTPDL
MOVE F,IPSDF1(T) ;RESTORE APR FLAGS TO THOSE AT INTERRUPT TIME
MOVEM F,IMASK
INTMSK F
POP T,F
POP T,R
POP T,D
PUSH P,(T) 9RETURN PC
POPI T 5
MOREM T,INTPDL ;RESTORE INTPDL
POP FXP,T
SKIPL REEINT
HALT ;FOR DEBUGGING, THIS SHOULD NOT HAPPEN UNLESS
;CODE IS NOT PAIRED CORRECTLY
; (DISINT[DALINT]/REAINT)
SKIPG REENOP
POPJ P,
MOVEM T,REESVT ;WE NEED AT LEAST ONE AC
MOVE T,INTPDL ;USE T AS THE INTPDL
ADD T,R70+10 ;WE MUST RESERVE THE SPACE WE WILL NEED
MOVEM T,INTPDL
SUB T,R70+5 ;BUT LEAVE 4 DUMMY WORDS + 1 FOR PC
POP P,(T) ;PC IS THAT WHICH WE WILL POPJ TO
JRST REETR1
;INTERRUPT HANDLING ROUTINES (DISPATCHED TO VIA SAIDSP)
INTERR: OUTSTR [ASCIZ\AN ILLEGAL INTERRUPT HAS BEEN RECIEVED. THIS IS AN
INTERNAL LISP ERROR\]
HALT
PARINT: MOVSI R,(%PIPAR) ;FLAG THAT IS PARITY ERROR
JRST SAIMER
NXMINT: SKIPA R,[%PIMPV]
ILMINT: MOVSI R,(%PIWRM)
SAIMER: MOVE F,INTPDL ;INT PDL PGINTER INTO F
MOTEM R,IPSWD1(F) ;STORE GHERE MEMERR CAN FIND @ITS
JRST MEMERR ;PROCESS MEMORY ERROR
;HERE FOR <ESC>I INTERRUPT
EYEINT: MOVE F,INTPDL ;INT PDL POINTER INTO F
SETZB R,IPSWD2(F) ;FORCE EXTERNAL CALL
; MOVM R,IPSWD2(F) ;GET <ESC>I ARG (POSITIVE FORM ONLY)
; CAILE R,177 ;ONLY CHARACTERS UP TO 177 HAVE MEANING
; TDZA R,R ;FORCE R TO ZERO
; TLO R,400000 ;FLAG THAT THIS IS AN INTERNAL AALL
; MOVEM R,IPSWD2(F) ;RESTORE ARGUMENT TM CHNINT
CLRBFI
JRST CHNINT ;FUDGE THE CHANNEL INTERRUPT
;JEW INTERRUPT MASK BITS, INDEXED BY CURRENT INTERRUPT NUMBER
SAIIMS: 0 ? 0 ? 0 ? 0
INTPOV ;MAIL INTERRUPT
0 ? 0
INTPOV ;PAR ERROR: ONLY ALLOW PDD OV
-INTCLK-1 ;CLOCK INT: ALLOW ALL OTHERS
0 ? 0 ? 0 ? 0 ;NOT USED, IMP INTERRUPTS
-<INTCLK\INTTTI>-1 ;<ESC>I: ALL EXCEPT <ESC>I AND CLOCK
0 ;CHANGING QUEUES, NOT USED
INTPOV\INTILM\INTNXM\INTPAR\INTPOV ;PDL OV: ALL MEMKRY ERRS AND PDL OV
0 ;PDP-11 INT, NOT USED
INTPOV ;ILM: ONLY PDL OV
INTPOV ;NXM: ONLY PDL OV
0 ? 0 ? 0 ;OVERFLOW AND OLD CLOCK TICK
;DISPATCH TABLE, INDEXED BY INTERRUPT NUMBER
SAIDSP:
REPEAT 6,INTERR ;INTERRUPT ERROR, THIS CANNOT HAPPEN
MAIINT
REPEAT 2,INTERR
PARINT ;PARITY ERROR
INTERR ;CLOCK INTERRUPT
INTERR ? INTERR ? INTERR ? INTERR ;VARIOUS IMP INTERRUPTS
EYEINT ;<ESC>I INTERRUPT
INTERR ? INTERR ? INTERR ;CHANGING QUEUES, UNUSED, UNUSED
PDLOV ;PDL OV
INTERR ? INTERR ;PDP-11 INTERRUPT, UNUSED
ILMINT ;ILL MEM REF
NXMINT ;NON-EXISTANT MEMORY
INTERR ? INTERR ? INTERR ;UNUSED, UNUSED, OLD CLOCK INT
INTERR ? INTERR ;UNUSED
INTERR ;FLOATING OVERFLOW
INTERR ? INTERR ;UNUSED
INTERR ;INTEGER OVERFLOW
REPEAT 4, INTERR ;UNUSED
] ;END IFN SAIL
αIFN D10*<SAIL-1>,[
SUBTTL DAC-10 ONLY NEWIO INTERRUPT CODE
;***A NOTE OF CAUTION
;WHENEVER THE INTPDL IS TOUCHED, IT IS DONE SO IN A CERTAIN ORDER OF
;INSTRUCTIONS. THIS IS NECESSARY TO PREVENT TIMING ERRORS FROM SCREWING
;UP THE PDL SLOT ALLOCATIOF (THIS PREVENTS SAVED AC'S, FOR EXAMPLE, TO
;BE OVERWRITTEN BY NESTED INTERRUPTS). DO NOT AHANGE ANY ORDERING OF
;THIS CODE WITHOUT METICULOUS CHACKING TO SEE THAT RANDOM, ASYNCHROJOUS
;INTERRUPTS WILL NOT CAUSE TOTAL LOSSAGE.
;INTERRUPT ENABLING/DISABLING
;ENABLE NORMAL INTERRUPTS, CALLED AT STARTUP
ENBINT: MOVEI T,REETRP ;REENTER TRAP ADR
MOVEM T,.JBREN
MOVEI T,APRTRP ;THIS LOCATION FOR ALL APR TRAPS
MOVEM T,.JBAPR ;INFORM↓)∨!&4b`A-%αA∃∨ β(~(∪≠∨-∃∩A(YM) ≠',~∀&lzR⊗5¬!2&6
~,$%]""&M∧JMα∞-∩J⊗:"α&:R-∩JVB"α6εNXh(&6⎇2⊗%α b>&6
~,$%\
2N≥∧JMα≡d!α&:$*JJV¬!α6ε≤X4(&≤*R>5¬∩⊗⊗&u $%nα(T,UHZ"∧LjHU∃∃Z
E~∧~(R∧|1Q M≤ZItj¬(XTt⎇↓⊃∪\∃ZD∧m-:D¬≤-Dλ$⎇$∧λdd z1PPM8ZETj →e$ IA⊂K]xT∧D
hYb="λI∃≤ )HT"∧→IB∧LjHU∃∃Z
E_h!_∃¬∀Yh"¬"AQ M∧z "¬αA⊃⊂K\it∧⎇$λZ"¬%(~¬~¬i_∩¬$ ~2∧lX9∧ t~9PhPβ"Nj(+13H_S⊃(λ_U⊃4Dλ∩4p()⊃(∩)j⊃4TJZ∃∀c!*Q02)J∞B4
Zrλ⊃K
∃β!!03thT⊂3Uλ→∪α"'_∩4p()⊃1λλ→∪λ∩)j∀kc!!(∀ri~⊂(∃¬Ir30*9b".iikλ∃*8(∪sλD∩3UλZTU4
D∪04i1"B(∧
rr4λ∀∃ ∩)X4rb!↔q3∀hT∃0q$λu4THYUλ∪(~rc"A∀λλ∪)zQ3(
E∩30*9b.u 4h∩*4∪Sud
∩⊃(λ:4TQ)jλ∪0*9c"B(~∀Q3H$∃ β!!4rr* ⊃(∀HX3St↓Q@∧P%∀)j⊂)⊃`dg βE∧ieRh#P)⊃bdg*βEP%∀)j⊂)⊃`dgλCE)"`Rg→≥∧Sgk"dH*⊗!h∪h%εEαfgk"SP*⊗↔∩!'h!CE∧h'T⊂#,( *εE∧R))j∀"bj) DD]c∃b#bP⊂P)"bS*"i⊂∩c⊂'g⊃P+`iH)"hjQij"bβE)"`Rg_]∧Tbj'fH)"bdS*εE∧Tbj'fH)"bg∪hεE∧T'h⊂#⊗(⊗*εB∧h'h∩⊂(⊗εBεE≥b∩i`a&⊃P f&λ!*j⊂∩fh'i∃ g*⊂∩g*"i∀*h*)CE"$iRg*≥∧T*id⊂⊃
↓MOVE T IMASK ;GET CURRENT MASK
MOVEM T,OIMASK ;REIEMBER IT FOR RESETIJG PURPOSES
ANDI T,AP.POV ;KNLY ALLOU AMPORTANT INTERRUPTS
MOVEM T,IMASK ;THIS IS CURRENT SDATE OF SYSTEI¬
SETZM REEINT ;NO REEH
) HO&A≥=*~∀∪¬!% ≥λA(X~(∪!∨ ↓
1 YP~∀∪!=!∀A 0~∀
∀m ∪'β →
Aβ1_Aβ≥Q %%+A)&~∃⊃β→β≥Pp∪!+M⊂A
1@Y(~∀%' )∨4A∪≥ ¬→_∩∩m⊃β-
↓ ∪'β →βλA¬→_A∪9) %%U!)&~(∪' )i∧A(YI ∪≥P~∀∪βA% ≥∧↓(X~∀%!∨ A→1 Y(4∀∪!∨A∀A X4∀~∀w¬!$A)Iβ A⊃¬≥ →∪9∞~∃βA%)% h∪' )i~A% ∃≥∨ ∩$wβ¬'=→+)→dA≥≡Ayε←% ∃≥) $↓∪≥) I%+!)LA≥∨.∧~∀∪≠=- ~APYβ!%M-(~∀%' )4↓(X~∀%β!% 9∧A(X$∩w≥≡↓∪≥) I%+!)LA +¬%≥∞A)Iβ A'∃)+ ~(∪≠∨-∀A(Y∪9)! _$∩w+'∀A(AβLA)⊃
↓∪∃)!⊃_~∃%∃! β(hXA!U'⊂A(0∩∩vd↓∪∃) I%+!(↓/∨% LAβ≥λdA →
% ⊂A/∨%⊃&~∀∪A+'⊂APX]∃¬Q!ε∩∩m∪∃) I%+!(↓!ε~∀%!+'⊂↓(Yλ∩$s'β-∀AβεOLAβ&A%)&A∪9) %%U!(A/=+→λA⊃≡~∀∪A+'⊂APY$
∀%!+'⊂↓(Y ~(∪≠∨-∃~A(Y%≥)! 0~∀β≠=-αAλ1∪∪β',∩∩w)!∪&A∪LA∂∨∪9∞A)≡↓∂≡A∪8A∪≥(↓≠β'⊗DA/∨%⊂~∀∪≠=) ~A⊂Y∪!'⊃ bQ($~∀∪'∃)4Aλ0~∀β≠=-
A 0]∃¬π9∩∩∩w≥ (Aβ
)+β_↓!%∨π∃''∨$↓↓∪)&4∀∪)%9
A Y¬ ]!βH~∀∩AQ→≡Aλ0PK!∪Aβ$R∩$s!β%%)2A I%∨$~(∪)%≥∀A Yβ@]!∨,$∩w! 0A∨,}4∀∩A∃I'(@IA →∨,4∀∪)%9
A Y¬ ]∪→4∩∩w↓U%
A!¶
A I%∨$}Q'⊃∨U→λA)!∪&A¬∀A≠!,|R~∀∩↓)→≡A⊂XPK!%/%≡R4∀∪)%9
A Y¬ ]≥14∩∩w≥=≤[ 1%')β≥PA≠ ≠=%2~∀$A)%≡↓λXK!%≠!,~(∪≠∨-∃~AλY%!'/λDQ(R~(∪≠∨-∀A(YβA%'-(4∀∪∃+5!≤Aλ1≠ ≠ I$~∀∪=+)')HA7β'
∪4A9U≥% π=∂≥∪5∃λAβ!HA∪≥)∃%%+!Q9:~∀%⊃β→(4∀~∀IA →∨,h∪≠∨-∀A(YβA%'-(4∀∪∃%M(A! 1∨,~∀4∀w ∪M≠∪'&↓β≤A∪9) %%U!(~∃⊃'≠∪≥Pt∪!+M⊂A
1@Y(~∀%≠∨-
↓(Y∪≥Q! _~(∪≠∨-∀A Y∪A' b!(R∩wI ')∨I
Aβ!HA
→β≥&A)≡↓)⊃∨'∀Aβ(A%≥) %I+!(AQ∪≠
~(∪≠∨-∃~A Y%≠β'⊗4∀∪β!I ≥∧A_X~∀∪A∨ A(1 ~∀∪A∨ A(1$~∀∪A∨ A(1λ~∀∪A+'⊂A@XQ(R$∩w% Q+%≤AAε~∀∪A∨!∩APXj~∀%≠∨- 4A(Y∪9)! _$∩w% M)∨%
↓∪≥)!⊃_~∀∪A∨ A
a Y(~(∪'↔∪A_A% ∃∪≥(~(∩A⊃β1(∩∩∩m
∨$A⊃ ¬+∂≥∪≥∞X↓)⊃∪&↓'⊃∨+1λA≥∨PA⊃β!A ≤A+9→ '&4∀∩∩∩$wπ∨ ∀A∪&A9∨(A!¬∪% λ↓π∨%%∃π)→2Q ∪'%≥)7 ¬→∪≥)t←% β%≥(R~(∪'↔∪A∞A% ∃≥∨ ~(∩A!∨A∀A X4∀∪≠∨Y ~A(1% 'Y(∩∩w]
A≥ ∃λAβ(↓→ β'PA∨≥
↓βε~∀%≠∨-
↓(Y∪≥Q! _∩$w+'
↓(Aβ&↓)⊃
A%≥)! 0~∀∪β⊃λA(YHn`Vb@∩∩w/∀A≠+'PA% '∃%-
AQ⊃
A'Aβπ
A]
A/∪1_A≥ ∃λ~∀∪5∨- ~↓(Y∪≥Q! _~(∪'+∧↓(Y$n@Vj∩∩m¬+(A1 β-
hA +5≠2A/=% &@,@bA
=$A!ε4∀∪!∨@A XQPR∩∩wAεA∪&↓)⊃β(↓/⊃∪π A/
A]∪→_AA∨!∀AQ≡~∀∪)%'(AI )$D~∃:w∃≥λA∪→≤Aλb@Ty'β%_Zb|4∀~∀wQ⊃
A
=→→∨/%≥∞Aπ=
A∪LA
∨$↓)∨!&4b`Aβ9λA'β%_~∃∪→≤Aλb@Y6~∀m⊃ %
↓
∨$A∧A+' HAπ⊃βIβπ) HA∪≥)∃%%+!PXA≠β-
Aβ≤↓∪≥)'Qβπ⊗A→%β≠
↓β≥λA
β→_A
⊃≥∪≥P~∃+π!∪≥(t%' )54A% %≥(∩∩m ∨≤OPAβ→→=.A=ε=% ≥Q %&AQ≡A∂≡↓)⊃%∨U∂⊂~∀%≠∨- 4A(Y%∃ '-($∩w/
↓≥ λ↓β(A→∃β'(A=≥
Aβ ~∀∪≠=-
A(1∪≥)!⊃_∩∩wU'
A(↓β&A)!
A∪≥Q! _~(∪β λ↓(Y$n@Vb`∩$w≠+'PA' (↓∪≥)!⊃_A)≡↓β
) HA∪)&↓% β_↓+'
AM≡A)⊃¬(~∀∩$∩∩w%∃π+%'%-
A∪9) %%U!)&AU'
A %
%∃≥(A'Qβπ⊗A¬% β&4∀∪≠∨Y ~A(1∪≥)!⊃_~∀∪M+∧A(1$n`VP∩∩w/∀A/∪→0A↔ @AαA U≠≠2A→∨+$A]∨% &4∀∪!+M⊂A(Yl`XYπA∨!∃:$w!εA→→β∂&`Aβ&↓)⊃ 2↓≠β2A≥ (A%∃')∨%∃λA¬2↓∃%'(dX~∀%!+'⊂↓(Yλ∩$w'β-∀AβεOLAβ&A%)&A∪9) %%U!(A/=+→λA⊃≡~∀∪A+'⊂APY$~∀%!+'⊂↓(Y ~(∪≠∨-∃~AλY%!'/λHQ(R~(∪≠∨-∀AλY∪5β'⊗∩$w!+(↓∨→λA%≠β'⊗↓∪≤A/=%λ@b↓≠β'⊗4∀∪≠∨Y ~Aλ1∪!' _bQ(R4∀∪≠∨Y
A(YI '-P~∀∪'∃)∨~AI ≥∨@~∀∪'∃)∨~AI ∪≥P~∀∪∃I'(Aπ!≥∪≥(4∀~∀~(w% 9) $AQ%β A¬ $~∃I )%@t∪β∨M∞A% ∃≥∨ ~(∩Aβ∨M→
A%∃ ∪≥($∩w% ∃≥) $↓β→→∨] λ}~(∩@A∃I') A]∃¬∨Aε∩∩w9∨!
X↓
→β∞↓β≥λA≥≡A∨≤4∀∪≠∨Y ~A(1% 'Y(∩∩w]
A≥ ∃λAβ(↓→ β'PA∨≥
↓βε~∀%≠∨-
↓(Y∪≥Q! _∩$w+'
↓(Aβ&↓)⊃
A%≥)! 0~∀∪β⊃λA(YHn`Vb@∩∩w≠U'(A'∃(A∪≥Q! _AQ≡Aβ
Q $A∪Q&A% ¬_A+'∀A'≡AQ⊃β(~(∩∩∩∩m% π+I'∪-
↓∪≥) I%+!)LA+'
↓ ∪
∃% ≥(↓')βπ,Aβ% ¬&~∀∪5∨- ~↓(Y∪≥Q! _~(∪'+∧↓(Y$n@Vh∩∩m/
A/%→_A↔∃ Aα↓ +≠≠dA
∨+HA/∨%⊃&~∀∪A+'⊂APX]∃¬=!ε∩∩m∪≥) I%+!(↓!ε~∃I )$Dt∪!+M⊂A(Y⊂∩∩w'¬-
Aβ O&AβLA∪)&↓∪≥) I%+!(↓/∨+→⊂A ≡~(∪!+' A(Y$4∀∪!+M⊂A(Y_~∀∪'∃)5~A%!'/λHQ(R∩$w
∨%
A≠βM⊗A)≡↓5 %≡↓β&A∪LA+' ⊂A'!
∪β→→d~∀∪≠=-
Aλ1∪≠β',∩∩w'Q∨%
A%≠β'⊗↓β&A/=%λbA5β'⊗~(∪≠∨-∃~AλY%!' DQ(R~(∪≠∨-∀A(Y%∃ '-(4∀∪' Q∨~A%∃ ≥∨ 4∀∪' Q∨~A%∃ ∪≥(4∀∪∃%M(Aπ⊃9∪≥(~):∩w 9λA∪
8Aλb`4∀_~∀~(vvvA]⊃ ≤AQ⊃
A∪9) %%U!(A∨
π+%&0Aβπ&↓λXA$0Aβ≥λ↓ A⊃βY
A¬ ∃≤A'βY λ\~(vvvA 2Aπ∨9- ≥)%∨≤Aβ8A∪≥)∃%%+!PA⊃β≥⊃→ $A5∨- &↓)⊃
A%≥)! 0A!∨∪9) $~(vvvA%≥)≡A_XA∂ Q&AαAYβ→∪λ↓
1 AA∨∪≥)∃$A∪≥Q≡A
1@XAβ≥⊂A!+'! &A)!
A∨→⊂~∀vvlAπ∨≥Q ≥)&↓∨ A
a A∨≥Q≡A)⊃¬(A! 0\~∀~(vvvAM)β≥ ¬%λA∪9) %%U!(A a∪(~∀lvvA/%→_A%∃')∨%∀A
1 ↓β≥λA⊂W$W 0Aβ≥λ↓ ∪'≠%'&A)!
A∪≥Q %%+A(\~∀4∃∪≥)a∪(t∪5∨-
A→1 XQ→1 R∩$w!∨ ↓
1 Y→1 ~∀%'↔∪!8A≥∨#U∪(∩∩mπ⊃ π,A
∨$↓+' $↓∪≥)&↓')βπ- λA¬dA∪≥(↓⊃β≥ 1 $~∀$A'↔∪A≤A∪≥Q
→∞∩$]'
↓π⊃ π-∩~∀∩A∃%'PA∪≥)a(d~∀%'↔∪!∀A∂π
a ∩∩w!∨.Aπ¬≤A∂π→1 A¬∀A≥∨≤55 %≡↓/∪)⊂↓≥∨#+%(A5 I≡}~∀$@]→∨M
~∀∪A+'⊂A→1 Y∪A'λQ $∩wβ%Iβ≥∂
↓)≡A%∃')∨%∀AλAβ9λA)⊃∀A!ε~(∪!+' A Y∪A'!εQ_R∩∩vQ∪≥π1+ ∪≥≤A
→β≥&BRA¬
) $↓π⊃ π-∪≥∞~(∪!+' A YπA1
→(∩∩vA→∨$A'Qβπ↔ ⊂A∪≥)∃%%+!Q&~∀∪5∨- ∩↓$Yπ↔$`~∀∪5∨- ~↓$Y∪!M!εQ $~∃∪≥Q1(dt4∃∪
≤↓λd`W⊂b`XA)%'(A⊃'≠∪≥P∩w ∪M≠∪'&↓)⊃
A%≥) %I+!(~)∪
≤A%)&Y69πβ→_↓∪≥)1Pr∩∩wI )+%8A!εA%&A∨≤↓)∨ A= A∪≥Q! _X4∀∩@]1∨'
@D```∩$vAβ≥⊂Aβ→'<A)⊃
↓∨→λA⊃
$↓/∨% L~∀~∃%≥)1(dt∪' Q4~∀∪M∪1¬∪PA9 ∪M≠∪'8$∩w ∪M≠∪'&↓∪≥) I%+!(4∀∩@@T```X1 >lVL∩∩w!= AβπLAλXAHXAβ≥⊂A A
%%'(~(∩h``@``XY%≥)! 0∩∩w∪9) %%U!(A'Qβπ⊗AA∨∪≥)∃$~∃:$∩w ≥⊂A∪
≤↓∪)&~(~∀vvlA')β9 β%λ↓→∨'∪9∞A∪≥Q %%+A(A 1%(~∀vlvA% M)∨% LA
1 0Aβ≥λ↓λW$W_Aβ&A%≥)1∪PA ∨ L\~∀vlvAβ→M≡A 1A π)&↓α@]→='
A I%∨$A
∨
A%≤A$\4∀~∃∪9)→∨&h∪≠∨-∀A
1 0Q
1 $∩∩w!= A
1@Y
1 4∃∪≥)1&bt~)∪
≤A⊂b`WλH`XA∃I'(A M≠∪≥($w ∪'5∪'&AQ⊃
A∪9) %%U!(~∃%
≤A∪Q&Y6]
β→_A%≥)→&d~∀∩@9→∨'
b```4∀~∃∪9)→&rh∪' )h~∀∪'%1¬∪(↓9 ∪'5∪'8∩$w ∪'5∪'&A%≥) %I+!(~(∩@@j@``XY⊃>lVf$∩w!∨@Aβπ&↓λXA$0Aβ≥λ↓ A
∪I'(~∀$@@@@@XY∪9)! _$∩w∪≥Q %%+A(A')¬π⊗A!=∪≥) H~∀∩@@@@@0Y∪!'AεQ R$w≥ .↓!ε∩∩m∪≤A∨I $AQ≡A'!∃π∪
24∀∩@@@@@X1∪!' _bQ R$w≥ .] b$vA)⊃∀@]→∨M
Aπ∨⊃
XA∨9
~∀∩@@@@XY∪!M dQ_R∩w≥∃.@] _d∩vA5+'(A5 ≥)∪=≤Aβ→0A)⊃∪LA)∨≡4∀∩h`@```X1$∩∩v9→∨'
↓ %%∨HAπ∨ ∀~∃:∩$w ≥λ↓∪
≤A%)&~∀4∀vvv↓ 1∪(↓∪≥) I%+!(0A∂∨∪9∞A)≡↓+' $↓∪≥) I%+!(↓⊃β≥ 1 $\~(vvvA¬%∂+≠∃≥(A
=$A)⊃∀A+∪≥PA%∨+Q∪≥
A%&A∪≤↓λ\~∀lvvA!⊃→&AβI
A∪≤↓∂∨∨λ↓'⊃β!∀A¬2A9∨.XA= Aπ∨U%'
\4∀~∃1U∪≥(t%'↔∪!∀A∂π
a ∩∩w
A 1Q%αA'U%
Aβ ∨+(AQ⊃
~∃%(H∩@9→∨'
$∩∩vA≥∨∨ ≥∃'&A∨_A)⊃
↓! →&∧~∃∪
8@yλb@Wλd`xXA⊃β1(~∀vlvv∪!= A
1@Y
1 $∩wβ(↓)⊃∪&↓!∨∪≥PA'⊃∨U→λA¬∀A'β≠∀Aβ&@↓'+∧A→1 Y$\`Vb~(∪≠∨-∀A
1 0Q
1 $~∀∪!U'⊂A 1∪!'! Q R∩$w!+' A∪≥)∃%%+!PA!εA=≤A')¬π⊗A
=$A+∪9(~∀∪A+'⊂A@Yπ!1⊃
→∀∩$wβ%%¬≥∂
A→∨$Aβ AλAβ9λA
→¬∂&A)<A¬
AI ')∨I λ~∀%!+'⊂↓
1 Y%!'λQ_R∩w↓U'⊂Aβ Aλ@Q
∨%∀A∪≥)∃%%+!PRA∨≤↓
1 ~(∪≠∨-∃~AλY%!'λQ_R∩∩w
β+'
↓λA)≡↓'+%-%-
A !
A ∪M≠∪&~)∪
≤A⊂b`WλH`Y6~(∪≠∨-∃∩AλYU∪≥(∩$w≥ .↓!ε~∀%≠∨- 4AλY∪A'!εQ_R∩w'Q∨%
A]⊃ %
↓∨→λAAεA/ 9(~∀∪)%'(A⊃'≠∪≥P∩∩w)! ≤A %'≠∪'LA)⊃
↓∪≥) I%+!(4∃:∩∩m ≥λA%
≤AλD`Wλd@~∀~∃%
≤A∪Q&Y6]
β→_Aa+∪≥(d~∀∩@9→∨'
b```4∀~∃1U∪≥(rh∪' )h~∀∪'%1¬∪(↓9 ∪'5∪'8∩$w ∪'5∪'&A%≥) %I+!(~(∩@@j@``XY⊃>lVf$∩w!∨@Aβπ&↓λXA$0Aβ≥λ↓ A
∪I'(~∀$@@@@@XY∪9)! _$∩w∪≥Q %%+A(A')¬π⊗A!=∪≥) H~∀∩@b```0Y+∪≥P∩∩w≥∃.A!ε4∀∩@@@@@X1))3 _b∩∩w9 .@]⊃ b~∀$h```@`XY)Q3 d$∩w≥ \@] H~∃:∩$w ≥λ↓∪
≤A%)&~∀
;;; MEMORY AND MPCODE ERRORS: PARITY, PURE, MPV, ILOP.
;;; ASSUME NO MORE THAN ONE HAPPENS AT A TIME.¬
MEMERR:
IT$ .SUSET [.BJPC,,JPCSAV]
MOVE F,INTPDL
MOVE D,FXP
SKIPE GCFXP
MOVE FXP,GCFXP
PUSH FXP,D
MOVN R,IPSWD1(F) ;THIS SEQUENCE KILLS THE LOW-ORDER
ANDCA R,IPSWD1(F) ; BIT FROM THE INTERRUPT WKRD
; FOR D10, WILL CONTAIN APR FLAGS OF MERIT
SKIPE R ;LOSE IF MORE THAN ONA BIT WAS SET
IT$ .LOSE
IFN D10+D20, HALT
↓MOVE R,IPSWD1(F)
HRRZ D,IPSPC(F)
IT$ CAIN D,THIRTY+5 ;DDT DOES ≠X IN LOCATION34
IT$ JRST $XLOSE
TLNE R,(%PI<PAR>) ;WAS IT A PARITY ERROR?
JRST PARERR
TLNE R,(%PI<WRO>) ;WRITE INTO READ-ONLY?
JRST PURPGI
TRNE R,%PI<ILO> ;ILLEGAL OPERATION?
JRST ILOPER
TRNN R,%PI<MPV> ;MEMORY PROTECT VIOLATION?
.VALUE ;NO??? WHAT HAPPENED???
CAIE D,UBD1↓ ;LET SPECPDL RESTORATION HAPPEN
JRST MPVERR ; EVEN IF ONE SLOT GOT CLOBBERED
AOS IPSPC(F) ;BUMP PC PAST OFFENDING INSTRUCTION
JRST INTXIT
MPVERR: SKIPA D,[UIMMPV]
PURERR: MOVEI D,UIMWRO
JRST MEMER5
ILOPER:
IFN D20,[
SKIPN TENEXP
↓ JRST ILOPR1
; THIS A CRUFTY BUT ADEQUATE THEORY OF ERJMP'S
HLRZ R,0(D)
CAIE R,320700 ;ERJUMP?
JRST ILOPR1
HLRZ R,-1(D)
CAIE R,104000 ;JSYS?
JRST ILOPR1
HRRZ R,0(D)
HRRM R,IPSPC(F) ;CLOBBER RESTART ADDRESS
↓JRST INTXIT
ILOPR1:
] ;END IFN D20
SKIPA D,[UIMILO]
PARERR: MOVEI D,UIMPAR
MEMER5: HRRZ R,INTPDL ;MACHINE ERROR! WHAT TO DO?
CAIN R,INTPDL+LIPSAV ;IF THE ERROR HAPPENED WITHIN AN INTERRUPT SERVER,
SKIPN VMERR ; OR IF USER SUPPLIED NO ERROR FUNCTION,
JRST MEMER7 9 CRAP OUT BACK TO DDT
MOVEI D,100000(D)
HRL D,IPSPC(F)
PUSHJ FXP,$IWAIT
JRST XUINT ;CALL USER INTERRUPT HANDLER
; JRST INTXIT ;MAY RE-DO LOSING INSTR, BUT SO WHAT?
; THAT'S A FEATURE, NOT A BUG.
ANDI D,777
MEMER7:
IFN ITS,[
HRRZ R,MEMER8(D)
JRST INTLOS
MEMER8:
OFFSET -.
UIMPAR:: 1+.LZ %PIPAR
UIMILO:: 1+.LZ %PIILO
UIMWRO:: 1+.LZ %PIWRO
UIMMPV:: 1+.LZ %PIMPV
OFFSET 0
$XLOST: .VALUE [ASCIZ \:≠ YOUR ≠↔≠⊗X LOST ≠↔PROCEED⊗ \]
JRST THIRTY+5 ;LET THE ≠X RETURN CORRECTLY
$XLOSE: MOVEI R,$XLOST ;CAUSE INTERRUPT DURING AN ≠X
MOVEM R,IPSPC(F) ; TO GO TO $XLOST (CROCK)
JRST INTXIT
] ;END IFN ITS
IFE ITS,[
MOVEI A,MEMER8(D) ;TRANSFER TO ONE OF THE LER3'S BELOW
EXCH A,IPSPC(F)
ANDI A,-1
JRST INTXIT
MEMER8:
OFFSET -.
UIMPAR:: LER3 [SIXBIT \PC AT WHICH MEMORY PARITY ERROR OCCURRED!\]
UIMILO:: LER3 [SIXBIT \PC WITH ILLEGAL INSTRUCTION CODE!\]
UIMWRO:: LER3 [SIXBIT \PC AT WHICH ATTEMPT TO WRITE INTO PURE PAGE!\]
UIMMPV:: LER3 [SIXBIT \PC WITH MEMORY PROTECTION VIOLATION!\]
OFFSET 0
] ;END OF IFE ITS
;;; IFN D10,[
;;; OUDSTR @MEMER8(@) ;GIVE ERROR IF USER DOESN'T WANT IT
;;; EXIT 1,
;;; JRST .-2
;;; ] ;END IFN D10
;;;
;;; IFN D20,[
;;; HRRO 1,MEMER8(D) ;GIVE ERROR
;;; PSOUT
;;; HALTF ;DHEN STOP EXECUTION NICELY
;;; ] ;END IFN D20
;;;
;;; IFN D10+D20,[
;;; MEMER8:
;;; OFFSET -.
;;; UIMPAR::[ASCIZ \?Parity error in job
;;; \]
;;; UIMILO::[ASCIZ \?Illegal op executed
;;; \]
;;; UIMWRO::[ASCIZ \?Write into read-only memory
;;; \]
;;; UIMMPV::[ASCIZ \?Memory protection violation
;;; \]
;;; OFFSET 0
;;; ] ;END IFN D10+D20
;;; I/O CHANNEL ERROR HANDLER
IFN ITS,[
IOCERR: MOVE F,INTPDL
MOVE R,FXP
SKIPE GCFXP
MOVE FXP,GCFXP
PUSH FXP,R
.SUSET [.RBCHN,,R]
SKIPN R
JRST IOCER8
.CALL SCSTAT
.LOSE 1400
LSH D,-33
HRRZ R,IPSPC(F)
MACROLOOP NIOCTR,ZZI,* ;ZZI MACROS DEFINE IOC TRAPS
SKIPL R
JRST IOCER8
IOCERA: HRRM R,IPSPC(F) ;CLOBBER RETURN PC
HLRZ R,R
CAIN R,400000+D ;WANT TO STICK IOC ERROR
MOVEI R,400000+IPSD(F) ; CODE INTO SPECIFIED AC,
CAIN R,400000+R ; BUT MUST BEWARE OF D AND R
MOVEI R,400000+IPSR(F)
MOVEM D,-400000(R)
JRST INTXIT
IOCER8: SKIPN IOCINS ;ANY USER IOC ERROR HANDLER?
JRST IOCER9 ;NOPE, LET DUPERIOR HAVE THE ERROR
MOVE R,IPSPC(F) ;PC IN R
;ERROR CODE IN D (SEE ABOVE)
;CALL USER WITH PC IN R AND ERROR CODE IN D.
;THE USER'S ROUTINE MUST NOT MUNG ANY AC'S OTHER THAN R AND D, THOUGH THE
;STACKS MAY BE USED. IF THE USER'S INSTRUCTION SKIPS, THE RIGHT
;HALF OF R CONTAINS THE PC TO DISPATCH TO AFTER THE DISMIS, AND THE LEFT HALF
;OF R CONTAINS 400000+<ADR IN WHICH TO STORE ERROR CODE>
PUSHJ FLP,@IOCINS
SKIPA
JRST IOCERA
IOCER9: MOVEI R,1+.LZ %PIIOC
JRST INTLOS
] ;END IFN ITS
;;; INTERRUPT FROM I/O CHANNEL.
;;; PRESENTLY ONLY TWO KINDS ARE HANDLED:
;;; TTY INPUT: INTERRUPT CHAR TYPED.
;;; TTY OUTPUT: **MORE**.
CHNINT: MOVE F,INTPDL
MOVE D,IPSWD2(F) ;GET WORD TWO INTERRUPT BITS
CHNIN2: MOVE R,FXP ;FXP MAY BE IN A BAD STATE IF
SKIPE GCFXP ; WITHIN GC, SO RESTORE IT AND
MOVE FXP,GCFXP ; THEN PUSH ITS OLD VALUE
PUSH FXP,R ;REMEMBER, PDL OVERFLOW ISN'T DEFERRED NOW
IFN ITS,[
MOVN R,D
AND R,D ;R GETS LaOWEST SET BIT
ANDCM D,R ;D GETS ALL OTHER BITS
SKIPE D
.SUSET [.SIIFPIR,,D] ;PUT ANY OTHER BITS BACK (THEY'RE DEFERRED)
MOVE D,R
JFFO D,.+1 ;FIND CHANNEL NUMBER
MOVNS R ; FOR SOME PENDING
ADDI R,43 ; INTERRUPT BIT
PUSH FXP,R ;SAVE CHANNEL NUMBER
SKIPN R ;CHANNEL 0 ??
JRST CHNI2 ;YES, THIS CAN HAPPEN IN STRANGE CASES
SKIPN CHNTB(R) ;UNOPEN DEVICE ??
.VALUE ;BUT DON'T ALLOW INTERRUPTS FROM CLOSED CHAN
CHNI1H: .CALL SCSTAT ;GET STATUS FOR THE CHANNEL
.VALUE
ANDI D,77 ;GET ITS INTERNAL PHYSICAL DEVICE TYPE
SKIPE D
CAILE D,2
JRST CHNI5
];END IFN ITS
IFN D10+D20,[
MOVE R,D
MOVE D,V%TYI
HLL D,ASAR(D) ;DOES "TYI" CONTAIN A TTY FILE ARRAY?
TLNN D,AS<FIL> ;IF NOT, THEN USE INITIAL TTY FILE ARRAY
JRST .+3
HLL D,TTSAR(D)
TLNN D,TTS<TY>
MOVEI D,TTYIFA
PUSH FXP,D ;SAR ADR ON STACK
] ;END IFN D10+D20
IFN ITS,[
HRRZ D,CHNTB(R)
MOVE D,TTSAR(D)
TLNE D,TTS<TY> ;IF IT'S NOT A TTY INPUT ARRAY, WE DON'T
TLNE D,TTS<IO> ;HAVE INTERRUPT CHAR DISPATCH TABLE
JRST CHNI5 ; SO JUST TREAT AS ENDPGFUN (I.E. RANDOM CHANL)
.ITYIC R, ;TYPE 0 IS TTY INPUT
JRST CHNI8 ;TIMING ERROR OR SOMETHING - IGNORE
] ;END IFN ITS
IFN D10,[
TRNE R,400000 ;IF NOT INTERNAL GET FROM USE
JRST CHNIZ ;ELSE WE HAVE ALREADY
OUTCHR ["?]
INCHRW R
SA$ TRO R,%TXCTL ;CONTROLLIFY THE CHARACTER
CHNIZ:
] ;END IFN D10
SA% IFN D10+D20, ANDI R,37 ;MAP ALL CHARS INTO CTRL CHARACTERS
SA$ ANDI R,777
PUSH FXP,R ;SAVE INTERRUPT CHARACTER
PUSH FXP,TT ; AND ALSO TT
HRRZ TT,-2(FXP) ;FETCH CHANNEL NUMBER
;FOR D-10, THIS IS ADR OF SAR
TTYI1:
IT$ HRRZ TT,CHNTB(TT)
HRRZ TT,TTSAR(TT)
IFN D10+D20,[
HRL TT,F.CHAN(TT) ;NOW GET CHANNEL #
HLRZM TT,-2(FXP) ;MAKE THE CHANNEL NUMBER CORRECT ON THE STACK
] ;END IFN D10+D20
JSP D,TTYICH ;GET BACK INTERRUPT FN IN R
POP FXP,TT
JUMPE R,CHNI2 ;NULL FUNCTION - IGNORE
MOVEI D,(R)
LSH D,-SEGLOG
MOVE D,ST(D)
TLNN D,FX
JRST CHNI4
MOVE R,(R) ;"FUNCTION" IS A FIXNUM
IFN ITS+SAIL,[
MOVEI D,(R) ;IF ANY OF THE SUPRA-ASCII
ANDCM D,(FXP) ; MODIFIER BITS ARE SET IN THE
MOVSS (FXP) ; "FUNCTION", INSIST THAT THE
ANDM R,(FXP) ; CORRESPONDING @ITS APPEAR IN
MOVSS (FXP) ; THE CHARACTER TYPED. SIMILARLY,
IOR D,(FXP) ; THE SAME BITS SET IN THE LEFT HALF
TRNE D,%TX<MTA+CTL+TOP+SFT+SFL> ; MEAN THAT THOSE BITS MUST BE OFF.
JRST CHNI2
] ;END IFN ITS+SAIL
ANDI R,177
MOVEI D,TRUTH ;MOOOOBY SKIP CHAIN OF SYSTEM INTS
CAIN R,↑A ;↑A (SETQ ↑A T)
HRRZM D,SIGNAL
IT$ CAIN R,↑C ;↑C (SETQ ↑D NIL)
IP$ SETZM GCGAGV
CAIN R,↑D ;↑D (SETQ ↑D T)
HRRZM D,GCGAGV
CAIN R,↑G ;↑G (↑G) ;AUIT
JRST CN.G
IFE D20,[
CAIN R,↑R 9↑R (SETQ ↑R D
↓ HRRRMD,TAPWRT
CAIN R,↑T ;@=P∩Q' Q"A=∧↓_
&1Hh %α≤*Rj5¬"εB↑∃ 4*@Q↔4,TD t2∧_hR∧β&↓PPL8→∀`$∀K↔Ja".wJ@∧T)bU(P ≡W NIL)
↓ SEPZM↓))3∨→ ∩∀∪
β∪≤AHY=.∩$p∞z\JBBJ>9⊃↓"N-"Eαz:αQ$Q!∩∧U*:B∧≤ejpHK1∀ααα∧∧ααD9HT
∩YzU%¬X@λ
E*#"A_p23D
K↔V↓⊃,p∂,αT"a)∪i⊂∪hUdj∀DNo,⊂(UdjεEαP%))U⊂!g↔⊗εE∧aPdg⊂) /)∧DNo-∧aT h⊂'Uj⊂"'H""*εB∧P%)∀j⊂!g -εE!R'$Y≥αija⊃,(⊗)
X∃YεB∧e))U⊂ g*⊗$jεEβεAεE⊂d'$Z∞∧h'hλ#,(⊗⊃∧D]i⊃`f⊂&∩i"P*Tbi⊂$S*"i)∃h*⊂#∃g!b$SeεE∧U)'P" ~___ _∧D]L↔≤P≡O⊂**,H$g(*U⊂$g*⊃i)*h∃⊂!d TεE!d∪$Z ]αh'h⊂⊃,(⊗)βEd)∪⊂"⊗!R'*!∀∀∀BE∧Tedh"H*g)"PfεE∧H%)h⊂∀⊗!d'∩Z!DDNa i#λP∀''Rg*"i∀*h*⊂ j*,TH'i⊂∀∪'dg*⊃i)*h∃⊂*∀FB∧P⊂⊂λ(*id∩⊂#$( ∩$k`Rj∧]aPf&)P∃dij RP g"λ)edh∀P$c⊂∩g⊂#aCEP⊂λ⊂⊂%)∀j⊂,*Rg*∧DNi*g)H*ibiλ$g*"T)*h*βEe)∀j⊂$g∃,$jεBεE$c∪⊂$j)K-FE!R'$Z]αd))-λ"⊗!d∪*!∀)
DD]aR"aeP∪jj⊂#∩f"P T) lFB∧d))⊗⊂"⊗*∃)`i∀⊃∀BE∧Tedh'λ#'W"Sh∀"∀BD]ieRh⊂$cλ"g"(⊂cbc'βEP%∀)j⊂!R'$\εB∧fgk⊃dP"⊗ ____ ∃↑→∃⊃'W"gT∃X←∧NY↔≤⊂∂←⊂) S"'f@⊃$f"P∩g*"i∀*h*εB∧e))U⊂!d'∩X DDNU∃&gT"U∃⊂∂←⊂"g⊃( cbQ'⊂#bU)P)*SεEεE⊂d'$\∞∧ijaλ#,(⊗∀≠X∃XCEe)∀j⊂$g∃,$jεB.]bg⊃⊂$c'λ$j)FBεEβεE≥]NP)'jU$g"P∃'P)j⊂aeP*T⊂$g*⊃i)*h∃⊂$g INTAR -- USED BY CHNINT, JOBINT, AND FNYITF
CHNI4C: MOVE F,UNREAR ;STACK UP INTERRUPT IJ THE
CAIL F,LUNREAR 9 NOINTERRUPT QUEUE
JRST TMDAMI ;OOPS! DOO MANY DAMN INTERRUPTS!
MOVE F,[400000+LUNREAR-1,,UNREAR+LUNREAR-2]
CHNI4H: POP F,1(F)
TLNE F,377777
JRST CHNI4H
MOVEM D,UNREAR+1
AOS UNREAR
HRRZ F,INTPDL
JRST 2(R)
α
; COMMENT FOR @ CHANGE
IFN JOBQIM,[
3;; INTERRUPT FROM INFERIOR PROCEDURE(S)
λJOBINT: MORE F,INTPDL
MOVE D,IPSWD2(F)
MOVE R,FXP
SKIPA GCFXP ;IF IN GC, FXP MAY BE
MOVE FXP,GCFXP ; SCREWED UP
PUSH FXP,R
MOVN R,D
AND R,D 9R GETS LOWEST SET BIT
ANDCM D,R ;D GETS ALL OTHER BITS
SKIPE D
.SUSET [,SIIFPIR,,D] ;PUT ANY OTHER BITS BACK (THEY'RE DEFERRED)
MOVE D,R
JFFO D,.+1
MOVNS R ;-22 < R < -11
SKIPN D,JOBTB+21(R)
.VALUE ;NO JOBARRAY???
HRRZ R,TTSAR(D)
SKIPN J.INTF(R)
JRST INTXIT ;NO INTERRUPTFUNCTIKF - IGNORA INTERRUPT
MOVSI D$(D)
TRO D,200 00+<2*J.INTF+1>
SKIPGE UNREAL
↓ JSP R CHNI4A ;GORP!(NOINTERRUPT T)
↓ PUSHJ FXP,$IWAIT
JRST XUINT
JRST INTXIT
] ;END OF IFN JOBINT
¬
¬
;;; TTSAR OF TTY INPUT FILE ARRAY IN TT.
;;; INPUT INTERRUPT CHARACTER IN R.
;;; RETURN ADDRESS IN D.
;;; RETURNS INTERRUPT FUNCTION IN R.
TTYICH:
IT$ TRZ R,%TX<TOP+SFL+SFT+MTA> ;FOLD 12.-BIT CHAR
SA$ ANDI R,777
SA% TRZN R,%TX<CTL> ; DOWN TO 7 IF NECESSARY
SA% JRST TTYIC1
SA% CAIE R,177
SA% TRZ R,140
TTYIC1: ROT R,-1 ;CDEVER ARRAY ACCESS
ADDI DT,FB.BUF(R) ;INTERRUPT FNS ARE IN "BUFFER"
HLR B,(TT)
SKIPGE R
HRRZ R,(TT) ;SIGN BIT OF R GETS CDEARED
JRST (D)
SUBTTL VARIOUS SYSTEM TTY ILPUT CHAR INTERRUPT HANDLERS.
CN.W: HRRZM D,TTYOFF ;IMMEDIATE TTYOFF (↑W)
PUSH FXP,T
PUSH FXP,TT
HRRZ TT,V%TYO
MOVE T,ASAR(TT)
TLNN T,AS.FIL ;Is "TYI" a File Array?
MOVEI TT,TTYIFA ; If not, substitute initial TTY file array
MOVE TT,TTSAR(TT)
TLNE TT,TTS<TY> ;IFF it's a TTY
PUSHJ FXP,CLRO3 ; ALSO DG (CLEAR-OUTPUT T)
CN.W0: POP FXP,TT
POP FXP,T
JRST CHNI2
IFN D20,[
CN.Z: PUSH FXP,T
PUSH FXP,TT
MOVEI T,CN.Z0 ;RETURN TO SUPERIOR (MAY BE IDDT)
MOVE TT,INTPDL
EXCH T,IPSPC(TT)
MOVEM T,CN.ZX
POP FXP,TT
POP FXP,T
JRST CHNI2 ;ALPT$G PROCEEDS
CN.Z0: HALTF
ALTP: JRST 2,@CN.ZX
] ;END IFN D20
IFN D10,[
CN.Z: SKIPE R,.JBDDT ;ANY DDT IN CORE?
JRST (R)
EXIT 1, ;RETURN TO MONITOR IF NO DDT, CONT CONTINUES
ALTP: JRST CHNI2 ;PROCEED ON ALTP$G
] ;END IFN D10
IFN ITS,[
CN.Z: PUSH FXP,TT ;WE NEED ONE AC TO HOLD CHANNEL NUMBER
HRRZ TT,-2(FXP)
.CALL CKI2I
.VALUE
POP FXP,TT
.VALUE [ASCIZ \:≠DDT≠
\]
JRST CHNI2
CKI2I: SETZ
SIXBIT \RESET\
400000,,TT
] ;END IFN ITS
CTRLG: HRROI D,-3 ;↑G - SUBR 0
PIPAUSE ;DISABLE THE INTERRUPT SYSTEM FOR NOW
SETZM UNREAR ;CLEAR OUT ALL STACKED INTERRUPTS
SETZM INTAR
HRREM D,INTFLG
SKIPE NOQUIT ;HOW CAN NOQUIT BE NON-ZERO?
IT$ .LOSE ; MAYBE THE USER SCREWED UP
IFN D10+D20, HALT
JRST CKI0 ;PROCESS THE FORCED QUIT
CN.X: SKIPA D,[-6] ;ERRSETABLE (↑X) QUIT
CN.G: HRROI D,-7 ;IMMEDIATE (↑G) QUIT
SKIPE UNREAL
JRST CN.G1
SETZMILL ALL INTERRUPTS STACKED UP
HRREI D,INTFLG
PUSHJ FXP,$IWAIT
SKIPA D,[CKI0]
JRST CHNI2 ;CAN'T PROCESS QUIT NOW
MOVEM D,IPSPC(F) ;IF CAN QUIT NOW, ARRANGE FOR SERVER
JRST CHNI2 ; TO RETURN TO INTERRUPT CHECKER
CN.G1: SETZM UNREAR ;KILL STACKED UNREAL INTERRUPTS
EXCH D,UNRC.G ;ELSE STACK UP AN UNREAL
TRNE D,1 ; ↑G OR ↑X INTERRUPT
MOVEM D,UNRC.G ;DON'T LET A ↑X DISPLACE A ↑G
JRST CHNI2
IFN ITS\SAIL,[
IFN USELESS,[
FNYINT: MOVE F,INTPDL ;COMMON HANDLER FOR FUNNY INTERRUPTS
MOVE D,FXP
SKIPE GCFXP
MOVE FXP,GCFXP
PUSH FXP,D
MOVE R,(R)
SKIPN (R)
JRST INTXIT ;EXIT IF NO USER HANDLER
HLRZ D,R
CAIE D,UIFTTR ;SPECIAL HACK FOR TTY-RETURN
JRST FNYIN0
HRRZ R,IPSPC(F) ;GET PC OF INTERRUPT
IFN ITS,[
CAIE R,TYICAL ;INTERRUPTED FROM CANONICAL INPUT WAIT?
CAIN R,TYICA1
HRLI D,Q$IN ;YES, ARG TO INT FUN IS 'IN
] ;END OF IFN ITS
CAIN R,TYIXCT ;ANOTHER CANNONICAL PLACE
HRLI D,Q$IN
FNYIN0: SKIPGE UNREAL
JSP R,CHNI4C ;MUST STACK UP IF UNREAL
] ;END OF IFN USELESS
RCLOK2: PUSHJ FXP,$IWAIT ;WILL STACK AND SKIP IF GC
JRST XUINT ;GIVE USER CLOCK INTERRUPT
JRST INTXIT
] ;END OF IFN ITS\SAIL
IFN ITS,[
;;; REAL TIME ALARMCLOCK
REALCLOCK:
MOVSI R,400000 ;SHUT CLOCK BACK OFF
.REALT R,
MOVEI R,Q$TIME
JRST RCLOK1
;;; RUNTIME ALARMCLOCK
RUNCLOCK:
MOVEI R,Q$RUNTIME
RCLOK1: MOVE F,INTPDL
MOVE D,FXP
SKIPE GCFXP
MOVE FXP,GCFXP
PUSH FXP,D
SKIPN VALARMCLOCK ;IGNORE IF THERE IS NO
JRST INTXIT ; ALARMCLOCK FUNCTION
MOVSI D,(R) ;TYPE 0, SUBTYPE 0 IS ALARMCLOCK
SKIPL UNREAL ;SKIP IF (NOINTERRUPT T)
JRST RCLOK2
MOVEM D,UNRRUN-Q$RUNTIME(R) ;STACK UP INTERRUPT
JRST INTXIT
IFN USELESS,[
;;; CLI INTERRUPT HANDLER
CLIINT: JSP R,FNYINT
UIFCLI,,VCLI
;;; RETURN OF TTY TO THE JOB
TTRINT: JSP R,FNYINT
UIFTTR,,VTTR
;;; SYSTEM GOING DOWN OR BEING DEBUGGED
SYSINT: JSP R,FNYINT
UIFSYS,,VSYSD
;;; MAR BREAK
MARINT: MOVEI R,%PIMAR
ANDCAM R,IMASK
.SUSET [.SMASK,,IMASK]
.SUSET [.SMARA,,R70]
MOVEI R,1+.LZ %PIMAR
SKIPN VMAR
JRST INTLS1 ;IN CASE (STATUS MAR) GETS LOUSED UP
JSP R,FNYINT
UIFMAR,,VMAR
] ;END OF IFN USELESS
] ;END IFN ITS
;;; STACK UP A USER INTERRUPT WHICH MUST BE DELAYED.
;;; ARGUMENT IS IN D AS FOR UINT; IT IS SAVED IN THE INTAR QUEUE.
;;; ASSUMES FREE USE OF ACCUMULATOR R.
;;; PI INTERRUPTS MUST BE DISABLED!!!!
.SEE PIOF
YESIN1: POP P,UISTAK ;THIS IS A HORRIBLE CROCK
;UISTAK: 0
UISTK1: MOVE R,INTFLG ;IF WE ARE ABOUT TO QUIT ANYWAY,
AOJL R,@UISTAK ; THEN FORGET THE WHOLE THING
AOS R,INTAR
CAILE R,LINTAR
JRST TMDAMI ;TOO MANY DAMN INTERRUPTS
MOVE R,[400000+LINTAR-1,,IJTAR+LINTAR-2]
UISTK2: POP R,1(R)
TLNE R,377777
JRST UISTK2
MOVSM D,INTAR+1
SETOM INTFLG
JRST @UISTAK
TMDAMI: SKIPN GCFXP ;TOO MANY DAMN INTERRUPTS
JRST TMDAM2
IRP X,,[P,FLP,FXP,SP]
MOVE X,GC!X
TERMIN
TMDAM2:
; LERR [SIXBIT \TOO MANY DEFERRED INTERRUPTS!\]¬
IFN ITS,[
.VALUE [ASCIZ \:≠TOO MANY DEFERRED INTERRUPTS≠↔CONTIN⊗
\]
.LOSE
] ;END OF IFN ITS
10$ OUTSTR YASCIZ \TOM MANY DEFERRED INTERRUPTS\]
10$ EXIT 1,
10$ JRST .-1
¬
IFN D20,[
HRROI 1,[ASCIZ \
?Too many deffe@IKHAS9iKeeUaif~)9:
∀%⊃β→)_~∃*∩$w ≥λ↓∪
≤A⊂d`~∀4∀w#≠¬%⊗@Z4A)⊃∪LA∪&A! %
AM≡A¬β-)%βπ∀A/∪→0A
∪≥⊂A∪(A¬&A→βM(A'+ $@QβI∂∞BB$~∃#≠¬%⊗t∪5∨- ∩↓αY#~4∀∪!∨A∀A X4∀~∀_~∧~(vvvAA+%
AAβ∂
AQ%β A!β≥ →∃$~∀vlrAπ∨5 &A⊃∃%
A∂%)⊂A→='∪≥∞↓!εA∪8Aλ\~(∩]' ∀A≠ ≠∃%$~∀4∃!+¬A∂∩t~)∪
≤A⊂b`TxD['β∪0|Y6~(∪'↔∪A
A↔αDa ~∀$A'∨'∧AλY∪A'!εQ_R∩@@w≠β↔∀A!εAA∨∪≥(↓)≡A∨→
≥ %≥εA∪9')%+
)∪∨≤4∀∩@AM↔∪!α4∀∩@@↓β≥ ∩↓λXZb4∃2∩w∃→A∨_A∪
≤↓λb`Tpb['β%_|~∃%
≤AλH`Y6~(∪'↔∪A≤A) 9 1 ∩$@@@W% A) 9 0HAAαA ∪≥⊃(A≥=(A¬
↓%∪∂⊃P~∀αA)%'(AA+%!∂∧~∀∪!U'⊂A
a Xb~(∪!+' A¬!0d~∀∪5∨% ∩bP⊃~4BN2_hP&≡R∃αT$∧J↓↓↓n<*QαR∀
AαNαH∃%-4 ∀u$tε∩b¬z)∃$(⊃⊂*H(∩3JIhλC!!5∪∪Id + εε λ _αDP⊂⊂∞βBIT 10 -↓%ββλ↓% #+∃'(~∀$A)→≥8@bX`@```H$∩@@@m↓∪(@Dj@JA]%∪)
↓% #+∃'(~∀$@A'↔%!α∩∩$@@@wI βλAI"P⊃α⎇⊃α:=¬:J&R*αJE↓jiαB
∧JMα≡Xh(%↓ααN>M∧!2&B≥α
"→HI↓↓↓\z22e¬:J&R*αJE1¬α>&: αR=α ~RVεbα& 5:J%,≥I→t`H!→¬∃∃*4∧ H⊃∀ααβ89D,
$λt
∀(_t*∧h)tj∧HXe"∧λ→D0H!~∧⎇αλk¬αc!⊃∩ααπ:$-≥Iz$*∧_4u_h!~∧⎇αλk¬αc⊃Q%¬-*λt PQ+PK\YhB∧Li`∧#∪↓Q L≤→→b∧αJ:E
¬X!PPJ *%≥"λ
∧<KQQ%¬∧y⊗T PQ)∀4rλλ∀<LhqEHh)X∀≥∀yItmα j¬-∃J!E@+T
EA ∧P⊂λ≥m-(λ&`ai∪iP""Q$g"P∃d j∀& abTP λAVE @ANDLE@%L~∃ 4HIf⊗: α&~9¬αε≡εt84(→*Tm∧xT∧"eλ¬4HZTC"J
⊃r,g↓ ¬∧d∀)&P" $h)h⊂T#∀FB∧e))U⊂ g*⊗$jεEβE((#RXX
HRRRS A ∩∩@@w
=%∂ (αα2⊗~"α"ε20h(&∞ J0∩∧∃J¬<Ly→e H∀∧αβ\)→d$Lhp∧LuHZ%∃-
D∧LT _$M¬7$∧t⎇)X∀b¬
Z%%∀~↓PPJ *%≥"
∧<KX⊃PRα∧∧ααα∧ T⎇∀YP∧
e8¬∀)J6B"$∧λ∞tHYαbfa⊃i⊂+d∩a`λ VAHUE CELL UE DRIED TM GROL¬⊗~∀%≠↔-
↓λY7)%%!β)∀XY≥∪1:~∀∪5∨- ~↓λXQ'@R~∀∪M↔∪!
↓∂π
⊃@~∀%αrZε2,(4(ε zMα&¬~B
"2H$%N$z1=D
$-∀V(
I⊃(∪ zp3Qd 3Tu
*0q∩)Yβ⊂FEαh*`∪HJ FHP,$IWAIP ;LEP SPDL GET CAUGHT UP α SKIPA T,STQH +PH%n⊗∃∩6IαD
2α∩-⊃α↑εu"Mα∩|~εRε|qα&9¬ 4(¬αα*JN αBVJ-∩H$%\J:R↑ JQα6
IαN.M4*B∧:%I@!→¬∃∃αR(λE∪R3
85∀"!↔u∀R(Xλ∃∪d
∃1λ∀∃P3
X(⊂∀IZ⊃4U ∀⊃s@ @$fεEαe))jλ((#dLFEεE
SUBTTL USER INTERRUPT ROUTINES
;;; USER INTERRUPT TYPES FOR NEWIO
;;;
;;; FORM OF ARGUMENT TO UINT (ALSO STORED IN THIS FORM
;;; IN INTAR, ONLY WITH HALVES SWAPPED; WHY, I DON'T KNOW):
;;;
;;; 4.9-3.1 ARGUMENT FOR INTERRUPT FUNCTION
;;; 2.9 IF 1, SPECIFIES A TTY INPUT CHARACTER INTERRUPT.
;;; ARGUMENT IS TTY INPUT FILE ARRAY.
;;; 2.8-2.4 MUST BE ZERO.
;;; 2.3-1.1 CHARACTER WHICH CAUSED INTERRUPT, AS
;;; READ BY .ITYIC. THIS MAY BE A 12.-BIT
;;; CHARACTER, AND SO MAY HAVE TO BE FOLDED
;;; BEFORE SELECTING THE INTERRUPT FUNCTION.
;;; THIS IS PASSED AS THE SECOND ARGUMENT.
;;; 2.8 IF 1, SPECIFIES AN INTERRUPT RELATED TO A FILE
;;; ARRAY OR SIMILAR OBJECT, E.G. THE **MORE**
;;; INTERRUPT FOR TTY OUTPUT.
;;; ARGUMENT IS THE FILE ARRAY.
;;; 2.7-1.1 IS THE INDEX OF THE INTERRUPT FUNCTION
;;; WITHIN THE ARRAY, WHERE THE LOW BIT SPECIFIES
;;; LEFT OR RIGHT HALF AS USUAL.
;;; 2.7 IF 1, SPECIFIES A MACHINE ERROR.
;;; THE ARGUMENT IS THE LOCATION OF THE LOSS.
;;; BITS 1.9-1.1 SPECIFY THE NATURE OF THE ERROR.
UIMPAR==:0 ;ODDP ;PARITY ERROR
UIMILO==:1 ;EVAL ;ILLEGAL OPERATION
UIMWRO==:2 ;DEPOSIT ;WRITE INTO READ-ONLY MEMORY
UIMMPV==:3 ;EXAMINE ;MEMORY PROTECT VIOLATION
;;; IF 2.9-2.7 ARE ZERO, THEN:
;;; 2.2-2.1 TYPE OF INTERRUPT
;;; 1.9-1.1 SPECIFIC INTERRUPT
;;; CURRENT TYPES AND SPECIFIC INTERRUPTS ARE:
;;; 0 RANDOM ASYNCHRONOUS (DELAYED BY (NOINTERRUPT T))
;;; 0 ALARMCLOCK
UIFCLI==:1 ;CLI-MESSAGE ;USELESS
UIFMAR==:2 ;MAR-BREAK ;USELESS
UIFTTR==:3 ;TTY-RETURN ;USELESS
UIFSYS==:4 ;SYS-DEATH ;USELESS
UIFSMI==:5 ;SAIL-MAIL-INT ;USELESS
IFE USELESS, NUINT0==:1 .SEE GCP6Q6
IFN USELESS,[
SA% NUINT0==:5 .SEE GCP6Q6
SA$ NUINT0==:6 ;ALLOW FOR SAIL-MAIL INTERRUPT
] ;END OF IFN USELESS
;;; 1 RANDOM SYNCHRONOUS
;;; 0 AUTOLOAD
;;; 1 ERRSET FN
;;; 2 *RSET-TRAP
;;; 3 GC-DAEMON
;;; 4 GC-OVERFLOW
;;; 5 PDL-OVERFLOW
NUINT1==:6 .SEE GCP6Q6
;;; 2 ERINT (SYNCHRONOUS)
;;; 0 UNDF-FNCTN
;;; 1 UNBND-VRBL
;;; 2 WRNG-TYPE-ARG
;;; 3 UNSEEN-GO-TAG
;;; 4 WRNG-NO-ARGS
;;; 5 GC-LOSSAGE
;;; 6 FAIL-ACT
;;; 7 IO-LOSSAGE
NUINT2==:10 .SEE GCP6Q6
;;; WE NORMALLY DON'T PUSHJ HERE AT ALL FROM PI LEVEL!
;; (THINK ABOUT HOW TO SIMPLIFY THE CODE HERE.)
UINT: PUSHJ P,UINTPU
SKIPN NOQUIT
SKIPE INHIBIT
JRST UINT2
SKIPGE INTFLG
JRST UINT3
PUSHJ P,UINT0
.SEE UINTPU ;PEOPLE COME HERE TO UNDO UINTPU
;NOTE: THE PUSH'S OF UINTPU MUST SYNC WITH THE POP'S HERE
UINTEX:
IFN <D10+D20>,[
POP FXP,OIMASK
POP FXP,IMASK
] ;END IFN <D10+D20>
SKIPL (FXP)
JRST UINTX1
PIONAGAIN
IT$ .SUSET [.SDF1,,R70]
IT$ .SUSET [.SDF2,,R70]
UINTX1: SUB FXP,R70+1 ;GET RID OF REENABLE INTERRUPTS FLAG
POP FXP,R .SEE UINTPU
JRST CHECKI ;PDL-OVERFLOW MAY HAVE BEEN STACKED
.SEE PDLOV
UINT2: JSR UISTAK ;DELAY A USER INTERRUPT, SINCE INHIBIT SWITCH IS ON
JRST UINTEX
UINT3: HRRZ D,INTFLG ;CHECK INTERRUPT FLAG TO SEE THAT IS SAYS "QUIT"
CAIE D,-1 ;AND NOT SOME INCONGRUOUS USER PI
JRST CKI2
HHCTB: .VALUE
; LERR EMS11 ;HOW THE HELL CAN THIS BE?
UINTPU: ;PUSH PI STATE, THEN DISABLE
PUSH FXP,R ;SAVE R FOR UISTAK, ETC.
PUSH FXP,T
IFE ITS,[
PUSH FXP,IMASK ;SAVE APRENB MASKS
PUSH FXP,OIMASK
MOVN T,INTALL ;GET PI STATE FROM INTERNAL WORD
EXCH T,-2(FXP)
SKIPGE -2(FXP)
PIPAUSE
] ;END IFE ITS
IFN ITS,[
.SUSET [.RPICLR,,T]
EXCH T,(FXP)
SKIPGE (FXP)
PIPAUSE
] ;END OF IFN ITS
POPJ P,
;;; SAVE THE WORLD FOR A USER INTERRUPT, INVOKE IT, AND RESTORE.
;;;
;;; SAVED QUANTITIES INCLUDE ALL ACCUMULATORS, THE PDL POINTERS
;;; (FOR FRETURN), AND THE SUPER-WRITABLE STUFF (TEMPORARIES IN
;;; LOW CORE USED BY INTERRUPTABLE FUNCTIONS).
;;; MANY GLOBAL SWITCHES ARE BOUND AND RESET.
;;; FOR ASYNCHRONOUS USER INTERRUPTS, THE (NOINTERRUPT T) STATE
;;; MAY BE ENTERED; THE PREVIOUS NOINTERRUPT STATE IS SAVED.
;;; MUST NOT COME HERE WITHOUT FIRST USING THE $IWAIT
;;; ROUTINE TO DECIDE WHETHER OR NOT WE ARE IN GC.
;;; ALSO MUST CHECK THE NOINTERRUPT SWITCH BEFORE COMING HERE
;;; IF THAT IS RELEVANT TO THE PARTICULAR USER INTERRUPT.
;;; INTERRUPTS MUST BE TURNED OFF WITH PIOF BEFORE COMING HERE.
;;; THE WORD DESCRIBING THE USER INTERRUPT MUST BE IN D.
YESINT: SKIPN NOQUIT
SKIPE INHIBIT
JRST YESIN1
UINT0:
IT$ .SUSET [.SDF1,,TTYDF1] ;MUST ALLOW PDL OVERFLOW AND MEMORY
IT$ .SUSET [.SDF2,,TTYDF2] ; ERRORS TO GO THROUGH, BUT NO OTHERS
IT$ PION
IFN D10+D20,[
SETZM INTALL ;UNDO THE 'DALINT'
PUSHJ P,DISINT ;DISABLE APPROPRIATE INTERRUPTS
] ;END IFN D10+D20
HRRZS (P) ;WILL HRROS IF ASYNCHRONOUS
PUSHJ P,SAVX5 ;SAVE NUMERIC ACS
PUSH FXP,UNREAL
PUSH FXP,SPSV
BG$ PUSH FXP,BNV1
MOVSI R,-LSWS
PUSH FXP,SWS(R)
AOBJN R,.-1
PUSHJ FXP,SAV5
MOVEM SP,SPSV ;START BINDING VARIABLES
MOVEI AR1,NIL
MOVEI A,LISAR
PUSHJ P,BIND4
HRRZ AR2A,V%IBVL ;GET THE +INTERNAL-INTERRUPT-BOUND-VARIABLES
MOVNI C,512. ;DON'T TRY TO BIND TOO MANY THINGS
UINT0A: SKOTT AR2A,LS
JRST UINT0B
HLRZ A,(AR2A) ;BIND ALL USER-SPECIFIED VARS TO ()
PUSHJ P,BIND
HRRZ AR2A,(AR2A)
AOJL C,UINT0A
UINT0B: JSP T,SPECX
PUSHJ FXP,RST5
SETZM PA4 ;PA4 MUST BE IN THE "SWS" AREA
IFN USELESS, SETZM TYOSW
SETZM INHIBIT
SETZM EOFRTN ;DO NOT SETZM CATRTN! GJS WANTS
SETZM BFPRDP ; TO THROW OUT OF USER INTERRUPTS
SETOM ERRSW
MOVE T,[-LINTPDL,,INTPDL] ;MUSTN'T CALL UINT0 FROM
CAME T,INTPDL ; WITHIN A PI SERVER
.LOSE
REPEAT 3, PUSH FXP,R70 ;RANDOM SLOTS FOR NUMERIC ARGS;
; ; ALSO 4.9 OF TOP ONE => RETURN VALUE MATTERS
UIXPUSH==:6+1+BIGNUM+LSWS+3 ;AMOUNT OF STUFF PUSHED ON FXP
UISWS==:-<LSWS+3>+1 ;WHERE SWS STARTS WHEN SAVED ON FXP
UISAVT==:UISWS-7-BIGNUM ;WHERE ACCUMULATOR T GETS SAVED
PUSH P,[$UIFRAME] ;FRAME MARKER AND PDLS SAVED
PUSH P,FXP ; SO THAT THROW AND FRETURN WIN
HRLM FLP,(P) .SEE UIBRK
PUSHJ FXP,SAV5 ;SAVE ARGUMENT ACS AND 40 ON
PUSH P,40 ; REGPDL FOR GC PROTECTION
PUSH P,PA3
UIFRM==-3-NACS ;LOCATION OF FRAME ON REGPDL
UISAVA==UIFRM+2 ;LOCATION OF AC A ON REGPDL
MOVEI A,UIFRM(P)
MOVEM A,UIRTN
MOVSI AR2A,(CALLF 1,)
HLRZ A,D ;GET FIRST ARG FOR INTERRUPT FN
TRZN D,400000 ;DECODE INTERRUPT TYPE
JRST UINT30
HRRZM D,(FXP) ;TTY INPUT INTERRUPT CHAR
MOVEI R,(D)
MOVE TT,TTSAR(A)
JSP D,TTYICH ;FETCH INTERRUPT FN
MOVSI AR2A,(CALLF 2,)
HRRI AR2A,(R)
MOVEI B,(FXP) ;SECOND ARG IS CHARACTER
JRST UINT31
UINT30: TRZN D,200000
JRST UINT32
MOVEI TT,(D) ;RANDOM FILE INTERRRUPT
ROT TT,-1
HRR AR2A,@TTSAR(A) ;FETCH INTERRUPT FUNCTION
SKIPL TT
HLR AR2A,@TTSAR(A)
UINT31: HRROS UIFRM-1(P) 9ASYNCHRONOUS INTERRUPT
JRST UINT40
UINT32: TRZN D,100000
JRST UINT33
HRRZM A,-1(FXP)
MOVEI A,QODDP(D) ;MACHINE ERROR
MOVEI B,(FXP)
MOVEI C,-1(FXP)
MOVEI AR1,-2(FXP)
MOVSI AR2A,(CALLF 4,)
HRR AR2A,VMERR
JRST UINT40
UINT33: LDB TT,[110200,,D] ;BITS 2.2-2.1 ARE CLASS
ANDI D,777 ;1.9-1.1 ARE SUBTYPE
XCT UINT90(TT) ;FETCH INTERRUPT FUNCTION
XCT UINT91(TT) ;SPECIAL HACKS
UINT40: SKIPGE UIFRM-1(P)
SETOM UNREAL
PIONAGAIN ;***** RE-ENABLE INTERRUPTS *****
IT$ .SUSET [.SDF1,,R70]
IT$ .SUSET [.SDF2,,R70]
TRNN AR2A,-1 ;ONLY PROCESS INTERRUPT IF INT FUNCTION NON-NIL
TDZA A,A ;FORCE A RETURNED VALUE OF NIL IF IT MATTERS
XCT AR2A ;APPLY INTERRUPT FUNCTION
HRRZ T,UIFRM+1(P)
CAIE T,(FXP)
PUSHJ P,UINT45
HLRZ T,UIFRM+1(P)
CAIE T,(FLP)
PUSHJ P,UINT46
PIPAUSE
SKIPGE FXP) ;IF RETURN VALUE MATTERS
MOVEM A,UISAVA(P) ; SAVE IT FOR REPU@%8~∀∪!U'⊃∀A@Y+≥¬%→λ∩∩m% ')=%
A→%'β$X↓ !ε\4∃+∪≥Pa0t∪!%→∩AHY+∪']&Q
1@R~∀∪!%%∩AHY'/&4∀∪¬→PA$Y']&W→']&Zb∩m% ')=%
A'U! $[]%∪)β →
AπQ+
~(∪'+∧↓
1 Yl[+∪']&VbX0[+∪']&Vc:4∃¬∞H%!∨ A→1 Y¬9,b~∀%!∨ A@Y!αf4∀∪!∨@A Xh@~∀∪!U'⊃∀A→1 Y%M(k~b4∀∪!∨@A XZHQ R∩m↔≥∨π,A∨
↓!↓→&↓β≥λAU∪
%β5
XA'¬-∪≥∞4∀∪'+λA Y$\`Vb∩lA'β-∃λAπ∨9) ≥)LA∨ A∧A
∨$↓!∨!β(A¬ →=.~∀∪A∨ A
a Y'!M,∩w%∃gi←e∀AgiCQJA←L↓'! π ∪≥ S9N~∀∪A∨ A
a Yλ∩m∨→λAM)β)
↓∨ A+9% β_4∀∪'↔%!_@ZDQ R∩m∪ A∪9) %%U!(A/¬'≤O(↓β'3≥
⊃%∨≥=+&X~(∩A∃%M(A+∪9(pp∩lA≠+'Q≤O(A¬)) ≠A(A)≡↓% ')=%
A+9% β_4∀∪ 1
⊂AλYU≥% β0∩w/ 1_XA/∀A/β≥PA)≡AI ')∨I
A∪(8A/β&↓∪ A∨8~∀∪∃U≠!
A⊂Y+∪≥Ppp∩v↓∃+'(↓≥∨.}↓∪ A≥=(XA%∃)+%≤8~∀∪'-∪!
A∧Y+≥%∃β_∩w⊃∪λA/∀A∃+'PA)+%8A∪(A=
A¬dA% 'Q∨%∪≥≤A∪(}4∀∩A∃I'(A+%≥(a4$w≥≡X↓∪(O&↓')∪→0A∨≤@4A% U%≤\~)+∪≥(A≤t∪⊃I%4A(0ZbQ $∩w∪&↓)⊃
A
⊃ π↔TA%∨+Q∪≥
A%)' →_Aπβ→1∪≥∞A5
}~∀%ββ∪∂∀A(Y 9∨∪≥($vA ∨8O(A/¬≥(A)<A∂ (↓')+π,A∪≤A%≥
∪≥%) →24∀∩Aπ¬∪∂
APY≥∨∪9) %%U!(∩v↓% π+I'∪-
↓πβ→→L~∀∩@↓!+'⊃(A Yπ! π↔"$w⊃βπ-∪'⊂A∃≥)%2↓∪≥)≡↓π⊃ π-*~∀∪)%'(AU∪≥(p`~∀
∃U∪≥(aht∪'↔%!→
AU≥% β0~∀∩A)+≠!→∀AλY+%≥(a≤4∃+∪≥Pppt∪A+'⊃∀↓ Y%'Q0j~∀%!∪∨≥¬∂β∪≤$∩w%
5 ≥β¬1
A∪≥Q %%+A)&~∀%∃%'(↓!∨!β(~∃ +%≥(`th∩∩]'∃
A! 1∨,∩w∃≥λA∨_A+∪≥P`~∀~)+∪≥(Pjt∪'-∪!αAλY7#
%1≥+≠t~∃+∪9(hlt$A≠∨-∃∩A∧YE
→∨≥U~~∀∪∃1π⊂A∧Y∧~∀%!+'⊃(A Y+%≥(hr4∀∪ 1
⊂AαYλ~∀∪!=!∀A 0~∀~∃U∪≥(hdt∪
β A7! 0A∨+(↓∨ A!!β'
A%≤A+'∃$A∪≥Q %%+A(@Q'e') ~↓ %%∨HRC:~(∩~∃+%≥(r`h∪⊃%$↓β$eα1-β→βI≠π→∨
⊗QλR$∩wβ→¬%≠π→=π⊗A'∃%∪ &4∀∪⊃%HAβ$e∧Y-β+Q
≤Qλ$∩∩w%¬≥ ∨~↓'3≥π!%∨≥∨U&~∀∪!%$AβHeαY-U Qλ$∩∩w I∪≥(AM %∪ L~∀∩]Yβ→+
$∩∩∩v|}~∀~)+∪≥(dbt∪⊃I%∨&AU∪
%~4bQ R$wβ→βI≠π→∨
⊗@QβM3≥π⊃I∨≥∨+LR~∀∪)
π_∩$∩w%β9 ∨~AM3≥π⊃I∨≥∨+L~∀∪'∃)∨~@!
1 R$∩w %%≥(@QYβ→+
↓≠β))∃%&R~(∩]-β1+
∩∩$v}}~(~∀_~∃π-∩`t∪A+'⊂A→1 Yλ4∀∪⊃%I4AλY%≥)
→≤~∀∪π¬∪≤Aλ0Zb~∀$A∃%'PAπ↔∩D∩∩w ∃→β3 ⊂A+' HA∪≥)∃%%+!P~∀∪!%!β+'∀~∃π↔$dt∪'∃)5~AU≥% βH~∃π↔$eαt∪M )5~↓+≥%ε9∞∩∩w
⊃ π↔TA∃∨∪9&A∪≤↓β(A)!∪&A!=∪≥(~(∪' )i~A∪≥Q
→∞∩$v∪% M (A)Q2∪≥≡↓% ' P~∀∪)I≥
Aλ0h∩∩wy0∩@@Zl∩∩@@Zd4∀∩A∃I'(Aπ-∩f∩∩m=∞∩@@Zn∩$@@@ZL~∃∪
8A∪)&-λd`Yl~∀∪!U'⊂A
a Yλ~(∪≠∨-∃∩A Y1π⊃≥)λZb∩wI ' (↓β→_AQ)2A
%→ &~)π↔∩e_t∪'↔%!≤AβHbYπ⊃9)∧Q $~∀∩A)%'(A
↔∩e D~∀∪≠=-
A)PY))'¬$Qβ$DR~∀∪Q→≥≤AQ(Y))L]π_∩$w ∨≤≥(A% M (A)!
A
∪1
A∪ ↓∪(A∪LAπ→∨M λ~∀$A)→≥8A)(YQ)&])d~∀∩@↓∃%'(↓π↔∩e_b~∀∪5∨- ∩↓(Yπ→I∩f~∀%)→≥
↓)(Y)Q&]∪≡4∀∩A≠=- ∩APYπ→%<f~∀∪A+'⊃∀↓
1 X!(R~∃
↔∩e Dt∪'∨)∞A Y
↔∩e 4∀∪!∨@A
1 1λ~∃:$∩w ≥⊂A∨ A%
≤A∪Q&Wλd@~∀b`⊂∪π→%
≡~∀D`H∪π1%¬
∩4∃π↔∩Lt~∃π-∩g∧t%)%≥≤↓λXd~(∩A'↔%!
A!M3≠ ~)%#∪)Ht∩@A1 %$Am'∪1¬%(A9#U∪(C9t∩w'≡↓ %%∨HA∨+(↓
∨$Ay0~∃∪→≤A+'∃→ '&)∪)&Yl~∀∪≠=-
A(1∪≠β',~∀∪)I≥≤A(0K!∪≠¬$~∀∩↓∃%'(↓π↔∩i∧~∀∩]M+' (↓6]%≠¬%αXYMβ-≠βI:~∀∩9'+' PA6]'5β%αX1$na:$wβ-∨%λA)%%!!∪≥≤A)⊃
↓≠β$A⊃+%∪≥≤A)⊃
↓ %%!= ~∃π-∩iαt4∃:∩∩m ≥λA= A∪
8A+' 1 '&U%)&~∀%!∪∨≥¬∂β∪≤4∀∪!+M⊃∀A
a Y %I!∨ ~(∪!∪!¬+'
~)∪
≤AU' → M&U∪)LY6~∀%)%≥
↓(XK!%≠β$∩$w %%A∨ A!I ' %Y &A(4∀∩@]M+' (↓6]'≠¬%αXYMβ-≠βI:∩~∃t∩∩w 9λA∨ ↓∪
≤AU' → M&U∪)L~∀∪≠=-
Aα1- %%1∪'(~(∪≠∨-∃~AαYY∪#+∨Q∪ ≥(4∀∪∃'@AαY I∪≥∩`4∀∪≠∨Y
A Y d∩∩w⊃%β')%εAβπQ∪∨≤A→∨$A=≤~∀∪'∃)5~AQ)3∨
_~∀∪'Q%(@b\Y↓%#%)$~∀%∃%'(↓→'!%Pb∩∩w]∪→_AA∪∨≤A]∪)⊃∪8A %∪9∪(~∀4∃π↔∩Dt∪'↔%!
A∪9⊃∪¬∪P∩∩w%∃)+%≤↓)≡A'∃%-∪π∀A)⊃
↓ →βe λA∪9) %%U!(~∀$A∃%'PA!∨!a ∀∩∩m¬+(A9≡A' I-∪π
↓/⊃ ≤↓∪≥⊃∪ ∪(@zZb~∀%!+'⊃(A Y+%≥)!*4∀∪' Q5~A∪9)
→∞4∀∪!+M⊂A Y∧~∀∪!U'⊂A 1α~∀∪!→→∨&↓∪≥⊃∪ ∪(~∀%'↔∪!≤AαY∪9)β$~(∩A→ I$A ≠Lbf∩∩m→∨'(↓+' $↓∪≥) I%+!(4∃π↔∩Eαt∪≠=-&Aλ1∪≥)βHQαR∩$w
∨$GC PROTECTION
MOVSM D,(P)
SOSG INTAR ;CYCLE THROUGH THE DELAYED INTERRUPTS
SETZM INTFLG ;TO PREVENT TIMING SCREWS, CLEAR INTFLG IF
; NO MORE INTERRUPTS PENDING
PUSHJ P,UINT0
SKIPLE A,INTAR
JRST CKI1A
SUB P,R70+1
POP P,A
SETZM INHIBIT
PUSHJ P,UINTEX
JRST POPXDJ
SUBTTL UUOH HANDLER (INCLUDING STRT)
;UUOH: 0 ;UUO HANDLER
UUOH0: MOVEM T,UUTSV
LDB T,[331100,,40]
CAIL T,CALL←-33
JRST UUOH0B ;PROBABLY A LISP "CALL" UUO
UUOH2: CAILE T,UUOMAX
SETZ T,
JRST @UUOH2A(T)
UUOH2A: ERRBAD ;0 IS ILGL, ILGL, ILGL
ERROR1 ;LERR ;UNCORRECTABLE LISP ERROR
UUOACL ;ACALL ;KLUDGE FOR NCALLING ARRAYS
UUOAJC ;AJCALL ;JRST VERSION OF ACALL
ERROR1 ;LER3 ;LERR, BUT ALSO PRINT ACCUMULATOR A
ERROR5 ;ERINT ;CORRECTABLE ERROR WITH SIXBIT MSG
POF1 ;PP Z$X ;PRINT OUT Z FROM DDT
STRTOUT ;STRT ;SIXBIT STRING TYPE OUT
ERROR5 ;SERINT ;CORRECTABLE ERROR WITH S-EXP MSG
TOF1 ;TP Z$X ;TYPEP PRINTOUT OF Z FROM DDT
ERRIOJ ;IOJRST ;HAIRY FROB TO GET I/O ERROR MSGS
STRTOUT ;STRT7 ;ASCII STRING TYPE OUT
IFN .-UUOH2A-1-UUOMAX, WARN [UUOH2A OUT OF PHASE]
UUOACL: PUSH P,UUOH
BAKPRO
UUOAJC: MOVE T,@40 .SEE ASAR
TLNE T,AS<FX+FL>
AOJA T,.+2 ;FOR NUMBER ARRAYS, ENTER AT HEADER+1
PUSH P,[UUONVL] ;FOR OTHER ARRAYS, USE NUMVAL CHECK ROUTINE
XCTPRO
EXCH T,UUTSV
SPECPRO INTACT
JRST @UUTSV
NOPRO
;;; DISPATCH ON "CALL" TYPE UUO, TRAPPING TO INTERPRETER IF NECESSARY
UUOH0B: CAILE T,NJCALF←-33
JRST UUOH2
MOVEM TT,UUTTSV
MOVEM R,UURSV
LDB TT,[270400,,40]
CAIG TT,15 ;LISP "CALL" TYPE UUOS
TDZA R,R
MOVEI R,-15(TT)
HRRZ T,40
UUOH0A: MOVEM T,UUOFN
TLZ T,-1
MOVEI TT,(T)
LSH TT,-SEGLOG
SKIPGE TT,ST(TT)
JRST @UUNAF(R)
TLNN TT,SY
JRST UUOH0C
TLZ R,700000 ;400000 => AUTOLOAD, 200000 => MACRO,
; 100000 => ALREADY DID AUTOLOAD
;;; FALLS THRU
;;; FALLS THRU
UUOH1: HRRZ T,(T)
JUMPE T,UUOH1A
HLRZ TT,(T)
HRRZ T,(T)
CAIL TT,QARRAY
CAILE TT,QAUTOLOAD
JRST UUOH1
2DIF JRST @(TT),UUOTRT,QARRAY
UUOH0C: TLNN TT,SA
JRST UUOH3A
HRRZ TT,ASAR(T) ;HANDLE CASE OF A SAR EFFICIENTLY
CAIN TT,ADEAD
JRST UUOH3A
MOVSI T,(T)
HRRI T,T
JRST @UUAT(R)
UUOH1A: JUMPL R,UUALT1
TLNE R,200000
JRST UUOMER
PUSH P,A
PUSH P,B
SKIPGE A,UUOFN
JRST UUOUER
HLRZ T,(A) ;OPENCODED SYMEVAL
HRRO T,@(T)
UUOH3B: POP P,B
POP P,A
SKIPN EVPUNT ;SHOULD WE ALLOW FUNCTIONAL VARIABLES?
CAIN T,QUNBOUND ;YES, IS IT BOUND?
JRST UUOH3A ;NO TO EITHER QUESTION, SO ERROR
JRST UUOH0A
;;UUO TRANSFER TABLE, ONCE FUNCTION TYPE IS KNOWN
UUOTRT:
IRPS LL,X,[A+S+FS+L+E+FE+MC-AL-]
IFSE X,+, @UU!LL!T(R)
IFSE X,-, UU!LL!T
TERMIN
;;; MOBY DISPATCH TABLE FOR DECODING UUO CALL TYPES!
;;; R=0 => COMPILED ROUTINE CALLING A SUBR TYPE
;;; R=1 => COMPILED ROUTINE CALLING A LSUBR TYPE
;;; R=2 => COMPILED ROUTINE CALLING A FSUBR TYPE
UUAT: UUOARR ;CALLING SUBR - IT'S AN ARRAY **WIN**
UUOS1A ;CALLING LSUBR - IT'S AN ARRAY
UUOS2A ;CALLING FSUBR - IT'S AN ARRAY
UUST: UUOS0 ;CALLING SUBR - IT'S A SUBR **WIN**
UUOS1 ;CALLING LSUBR - IT'S A SUBR
UUOS2 ;CALLING FSUBR - IT'S A SUBR
UUFST: UUOS10 ;CALLING SUBR - IT'S AN FSUBR
UUOS11 ;CALLING LSUBR - IT'S AN FSUBR
UUOSBR ;CALLING FSUBR - IT'S AN FSUBR **WIN**
UULT: UUOS7 ;CALLING SUBR - IT'S AN LSUBR
UUOLSB ;CALLING LSUBR - IT'S AN LSUBR **WIN**
UUOS9 ;CALLING FSUBR - IT'S AN LSUBR
UUET: UUOEXP ;CALLING SUBR - IT'S AN EXPR
UUOS5 ;CALLING LSUBR - IT'S AN EXPR
UUOS6 ;CALLING FSUBR - IT'S AN EXPR
UUFET: UUOS3 ;CALLING SUBR - IT'S A FEXPR
UUOS4 ;CALLING LSUBR - IT'S A FEXPR
UUOEX2 ;CALLING FSUBR - IT'S A FEXPR
UUNAF: UUOS ;CALLING SUBR - IT'S A NONATOMICFUN
UUL2N ;CALLING LSUBR - IT'S A NONATOMICFUN
UUF2N ;CALLING FSUBR - IT'S A NONATOMICFUN
UUALT: HRRZM T,UUALT9 ;FOUND AN AUTOLOAD PROPERTY
TLOA R,400000
UUMCT: TLO R,200000 ;MACROS ARE IGNORED, SORT OF
JRST UUOH1
UUALT1: TLOE R,100000 ;CALLING ANYTHING - IT'S AN AUTOLOAD
JRST UUOH3C ;LOSE IF JUST DID AN AUTOLOAD ALREADY
PUSH P,A
HLRZ A,@UUALT9 ;OTHERWISE AUTOLOAD THE FUNCTION
MOVE T,UUOFN
PUSHJ P,AUTOLOAD ;BETTER SAVE R, BY GEORGE!
POP P,A
MOVE T,UUOFN
JRST UUOH1 ;NOW TRY IT AGAIN
;;; MAY CALL UUOBNC AND UUOBAK ONLY WHEN *RSET IS KNOWN
;;; TO BE NON-NIL - AVOIDS CERTAIN TIMING ERRORS.
UUOBNC: POP P,UUOBKG ;UUOBKG WITH NO CPOPJ
HRROS UUOBKG ;FOR UUO GUYS THAT CALL IAPPLY,
JRST UUOBK0 ; WHICH ITSELF SETS UP A CPOPJ
UUOBAK: POP P,UUOBKG ;WATCH THIS CROCK!
JRST UUOBK7
;;;UUOBKG: 0
UUBKG1: SKIPN V.RSET ;CHECK TO SEE WHETHER IN *RSET MODE
JRST @UUOBKG ;SAVES ALL ACS; T HAS -<# OF ARGS>
UUOBK7: HRRZS UUOBKG
UUOBK0: SKIPE NIL
PUSHJ P,NILBAD
PUSH FXP,TT ;PDLS MUST BE AS FRETURN WOULD WANT
PUSH FXP,R ; TO RESTORE THEM TO
JUMPGE T,UUOBK1 ;IF T>0, THEN ASSUME 0, AND THE
JSP TT,ARGP0 ; ARGS WILL BE FILLED IN LATER
MOVNI TT,(T)
SKIPGE A
SETZ TT,
HRLM TT,(P)
JRST UUOBK8
UUOBK1: PUSH P,R70
UUOBK8: MOVEI TT,-2(FXP)
HRLI TT,(FLP)
PUSH P,TT
HRRZ TT,40
HRLI TT,(SP)
PUSH P,TT
JUMPLE T,UUOBK5
PUSH P,R70
JRST UUOBK6
UUOBK5: PUSH P,[$APPLYFRAME]
UUOBK6: MOVS R,40
HRRI R,CPOPJ
SKIPL UUOBKG ;MAYBE DON'T WANT THE CPOPJ
PUSH P,R
HRRZS UUOBKG
POP FXP,R
POP FXP,TT
JRST @UUOBKG
UUOSBR: HLRZ T,(T) ;*** FSUBR CALLED LIKE FSUBR
MOVEM P,UUPSV
MOVNI R,1
TLOA A,400000
UUOSB2: MOVEI R,1 ;R>0 SAYS DON'T DO FRAME HACKERY
UUOSB3: MOVE TT,40 ;OTHERWISE R HAS -<# OF ARGS>
UUOSB5: TLO T,(PUSHJ P,)
TLNE TT,(1←33) ;THE NO-PUSH, OR JRST, BIT. SEE DEFINITION OF JCALL
TLCA T,(JRST#<PUSHJ P,>)
PUSH P,UUOH
UUOSB6: JUMPG R,UUOSB7
EXCH T,R
JSR UUOBKG
EXCH T,R
UUOSB7: TLZ A,-1
TLNE TT,(20←33) ;THE NUMERIC CALL BIT. SEE DEFINITION OF NCALL
AOS T ;FOR NCALL, ENTER AT ENTRY+1
SKIPN VNOUUO
TLNE TT,(2←33) ;THE NO-CLOBBER BIT. SEE DEFINITION OF CALLF
JRST UUOXT0
SOS TT,UUOH
UUOSB4: LDB R,[331100,,(TT)]
CAIN R,XCT←-33
JRST UUOXCT ;MAKE XCT OF UUO WORK
MOVEM T,(TT)
UUOXT0: TLNN T,(34←33) ;CAUSE EXIT TO INDIRECT THRU ACALL
TLO T,(@)
UUOXIT: EXCH T,UUTSV
UUOXT1: MOVE TT,UUTTSV
MOVE R,UURSV
JRST @UUTSV
UUOXCT: LDB R,[220400,,(TT)] ;GET INDEX FIELD OF XCT
JUMPE R,.+2
HRRZ R,@UUOACS-1(R) ;IF NON-ZERO, GET CONTENTS OF THAT AC
ADD R,(TT) ;ADD IN ADDRESS FIELD
HLL R,(TT)
MOVEI TT,(R)
TLNE R,(@)
JRST UUOXCT ;MAKE INDIRECTION WIN
JRST UUOSB4 ;MAKE XCT OF XCT ... OF XCT OF UUO WIN
;;; TABLE OF WHERE TO FIND THE ACS AS THEY WERE ON UUO ENTRY
UUOACS:
IRPS X,,[A B C AR1 AR2A UUTSV UUTTSV D UURSV F FREEAC UUPSV FLP FXP SP]
X
TERMIN
UUOARR: HLRZ R,(T) ;*** ARRAY CALLED LIKE SUBR
MOVSI TT,(@)
JRST UUOS03
UUOS0: SETZ TT, ;*** SUBR CALLED LIKE SUBR
HRRZ R,UUOFN
UUOS03: MOVEM P,UUPSV ;THIS IS TO HELP UUOXCT
HLR TT,(T)
PUSH P,TT
LDB T,[270400,,40]
MOVNS T
PUSH FXP,T
PUSHJ P,ARGCHK ;SKIPS IF OK
JRST UUOS0E
POP FXP,R ;R NOW HAS -<# OF ARGS>
POP P,T
TLNN T,(@) ;FURTHER WORK NEEDED FOR CALLING AN ARRAY
JRST UUOSB3
MOVSI TT,TTS<CN>
HLL A,40 ;UUOSB7 WILL CLEAR LEFT HALF OF A
TLNN A,2000 ;DO NOT SET THE COMPILED-CODE-
IORM TT,TTSAR(T) ; NEEDS-ME BIT FOR A CALLF!
MOVE TT,40
TLZN TT,(20←33)
JRST UUOSB3
TLNN TT,(2←33)
JRST UUOAR2 ;NCALL'ING AN ARRAY MEANS CLOBBER,
PUSH P,[UUONVL] ; IF ANY, SHOULD BE TO ACALL
JRST UUOSB5
UUOAR2: TLNN TT,1000
TLOA T,(ACALL) ;NCALL, BUT NOT NCALLF => ACALL
TLOA T,(AJCALL) ;NJCALL, BUT NOT NJCALF => AJCALL
PUSH P,UUOH
TLZ TT,777000
TLZ T,(@)
JRST UUOSB6
UUONVL: SKOTT A,FX+FL
JRST UUONVE
FIX7: MOVE TT,(A) ;OF COURSE, THE ROUTINE HAD BETTER COME UP
POPJ P, ;WITH SOME LISP NUMBER AS VALUE
UUOS1E: PUSH FXP,D
MOVEI D,1
JRST UUOE3
UUOS2E: MOVEM D,(FXP) ;TAKE THE SPOT ALREADY PUSHED ON FXP
MOVEI D,3
UUOE3: PUSHJ P,SAVX3 ;ARGS WERE ALREADY ON PDL, HENCE MUST BE POPPED OFF
MOVEM B,QF1SB ;SO WE MIGHT AS WELL LIST THEM UP WHILE WE'RE AT IT
PUSH FXP,T
PUSHJ FXP,LISTX
POP FXP,T
MOVE B,QF1SB
JRST UUOE2
UUOS0E: SUB P,R70+1
UUOS0F: PUSH FXP,D
PUSHJ P,SAVX3
MOVEI D,0
UUOE2: TLNE D,2 ;D 1.2 => EXIT ADDRESS ALREADY BEEN HACKED
JRST .+4
MOVE R,40
TLNN R,1000
PUSH P,UUOH
PUSHJ FXP,SAV5M1
PUSHJ P,[MOVE TT,40
HRLS TT
PUSH P,TT ;NAME OF FUNCTION IN LH
TRNN D,1 ;1.1 => LISTING HAS ALREADY BEEN DONE
JSP TT,ARGP0 ;ARGS TO FUNCTION NOW ON PDL
MOVEM D,-1(FXP)
PUSHJ P,RSTX3 ;RECUPERATE - IF POSSIBLE, DO NEW EVALUATION
JRST WNAERR ;OR ELSE CRAP OUT ON WRONG NUMBER ARGS
]
UUOSE1: PUSHJ FXP,RST5M1
POP FXP,D
POPJ P,
UUOS1: HRRZ TT,(T) ;*** SUBR CALLED LIKE LSUBR
HLRZ T,(T)
EXCH T,UUTSV
JSP R,PDLARG
HRRZ R,UUOFN
PUSHJ P,ARGCK0 ;FORCE CHECKING OF NUMBER OF ARGS
JRST UUOS0F
MOVE TT,40
TLNE TT,(20←33) ;THE NCALL BIT
AOS UUTSV
TLNN TT,(1←33) ;THE NO-PUSH, OR JRST, BIT. SEE DEFINITION OF JCALL
PUSH P,UUOH
JSR UUOBKG
JRST UUOXT1
UUOX4B: SKIPN UUOH ;=0 MEANS ENTRY FROM MAP SERIES
JRST (R)
PUSHJ FXP,SAV5M1
PUSH P,CR5M1PJ
JRST (R)
UUOLSB: MOVEM P,UUPSV ;*** LSUBR CALLED LIKE LSUBR
MOVEI A,NIL
HLRZ T,(T)
SKIPN V.RSET
JRST UUOSB2
PUSH FXP,T ;SAVE T (ADDRESS OF LSUBR)
MOVE T,UUTSV
PUSH FXP,T ;SAVE -<# OF ARGS> FOR UUOFUL
HRRZ R,UUOFN ;FOR ARGCK0
PUSHJ P,ARGCK0
JRST UUOS1E
MOVE R,T ;WATCH THIS SHUFFLING OF R, T, AND UUTSV!
JSP T,NPUSH-6 ;SIX SLOTS FOR "APPLY FRAME", ETC.
MOVE T,UUTSV
MOVEM R,UUTSV
MOVEI T,(P)
UUOLB3: AOJG R,UUOLB4 ;SO SLIDE STUFF SIX SLOTS UP THE PDL
MOVE TT,-6(T) ;AT END, T POINTS TO LAST OF THE FIVE
MOVEM TT,(T) ; FRAME SLOTS FOR UUOFUL
SOJA T,UUOLB3
UUOLB4: MOVE TT,40 ;FIGURE OUT IF CALL OR CALLF TYPE
MOVEI R,CPOPJ ; (MAY BE CALL TYPE IF 0 ARGS)
TLO R,(PUSHJ P,) ;FIGURE IT OUT
TLNE TT,1000 ;IT MAY LOOK LIKE WE'RE CONSTRUCTING A PUSHJ
TLCA R,(JRST#<PUSHJ P,>) ; TO THE WRONG PLACE, BUT READ THIS CAREFULLY!
HRR R,UUOH ;RETURN ADDRESS MUST GO UNDER
HRRZM R,-5(T) ; THE FRAME, NOT OVER!!!
HLLM R,-1(FXP) ;SAVE INSTRUCTION TO CLOBBER WITH
MOVEI TT,(T)
PUSHJ P,UUOFUL ;SO STICK AN APPLY FRAME UNDER ARGS, IF ANY
;REMEMBER, UUOFUL EXPECTS TWO FROBS
; ON FXP, AND POPS ONE OF THEM
POP FXP,T ;RESTORE T (ADDRESS OF LSUBR)
MOVE TT,40
JRST UUOSB7
UUOFUL: MOVS R,40 ;PUT FRAME UNDER LSUBR CALL
HRRI R,CPOPJ ;TT POINTS TO LAST OF 5 PDL SLOTS
MOVEM R,(TT) ;USES T,TT,R
MOVEI R,-2(FXP) ;FXP HAS -<# OF ARGS> AND ONE
HRRM R,-3(TT) ; OTHER SLOT AS WELL
HRLM FLP,-3(TT)
HRLM SP,-2(TT)
HRRZ R,40
HRRM R,-2(TT)
POP FXP,T
MOVEI R,(T)
HRLI R,-1(T)
ADDI R,(P)
SKIPN T
SETZ R,
MOVEM R,-4(TT)
MOVE R,[$APPLYFRAME]
MOVEM R,-1(TT)
POPJ P,
UUOS9: SKIPA TT,CILIST ;*** LSUBR CALLED LIKE FSUBR
UUOS7: MOVEI TT,ARGPDL ;*** LSUBR CALLED LIKE SUBR
MOVE R,40
TLNN R,1000
PUSH P,UUOH
HLRZ T,(T)
TLNE R,(20←33) ;THE NCALL BIT
ADDI T,1
PUSH FXP,T
PUSH FXP,XC-1
SKIPN V.RSET
JRST UUOS7A
MOVEI T,1
PUSHJ P,UUOBAK
REPEAT 2, SOS -3(P) ;ALLOW FOR TWO FROBS ON FXP
HRRZM P,(FXP)
UUOS7A: JSP TT,(TT) ;ARGPDL OR ILIST
POP FXP,R
JUMPL R,UUOS7K
SKIPN TT,T
JRST UUOS7H
HRLI TT,-1(TT)
ADDI TT,1(P)
UUOS7H: MOVEM TT,-4(R)
MOVE TT,[$APPLYFRAME]
MOVEM TT,-1(R) ;APPLYFRAME DONE
UUOS7K: MOVEM T,UUTSV
HRRZ R,UUOFN
PUSHJ P,ARGLCK
JRST UUOS2E
POP FXP,T
MOVEI A,0
JRST UUOXIT
UUOS2A: HLRZ TT,(T) ;*** ARRAY CALLED LIKE FSUBR
MOVEM TT,LISAR
MOVEI R,(TT)
MOVEI TT,IAPAR1
JRST UUOS2Q
UUOS2: HLRZ TT,(T) ;*** SUBR CALLED LIKE FSUBR
HRRZ R,UUOFN
UUOS2Q: MOVE T,40
TLNN T,1000
PUSH P,UUOH
TLNE T,(NCALL)
PUSH P,[UUONVL]
CAIN T,IAPAR1
PUSH P,LISAR
PUSH FXP,TT ;SUBR ADDR
CILIST: JSP TT,ILIST ;ILIST FORTUNATELY SAVES R
PUSHJ P,ARGCHK
JRST UUOS2E
JSP R,PDLARG
POP FXP,TT ;PRESERVE T FOR UUOBKG
CAIN TT,IAPAR1
POP P,LISAR
JSR UUOBKG
MOVEI T,(TT) ;BEWARE! LOOSE SUBR POINTER
JRST UUOXIT
UUOS1A: HLRZ TT,(T) ;*** ARRAY CALLED LIKE LSUBR
MOVEM TT,LISAR
MOVEI T,IAPAR1 ;HAIR SO INTERRUPTS WON'T SCREW US
EXCH T,UUTSV
JSP R,PDLARG ;SAVES TT
JSR UUOBKG ;ALSO SAVES TT, AND WANTS NOTHING ON PDLS
LDB R,[TTSDIM,,TTSAR(TT)]
MOVE TT,40
TLNN TT,1000
PUSH P,UUOH
TLNE TT,(NCALL)
PUSH P,[UUONVL]
MOVNI TT,(R) ;WNAERR will look at TT if error
CAMN TT,T
JRST UUOXT1
AOS R ;Fake an ARGS property from # of dims
PUSH FXP,D
PUSHJ P,SAVX3
JRST UUOE2
;;; PUTCODE [EXPR ← FSUBR]40
UUOS4: POP P,A ;*** FEXPR CALLED LIKE LSUBR
MOVN TT,UUTSV
JRST UUOS4A
UUF2N: SKIPA TT,40 ;*** NONATOMICFUN CALLED LIKE FSUBR
UUOS6: HLRZ TT,(T) ;*** EXPR CALLED LIKE FSUBR
MOVE R,40
TLZN TT,-1 ;UUF2N LEAVES LH OF T ↑= 0
HRL TT,R ;OTHERWISE GET SUBR EXPR NAME IN LH
TLNN R,1000
PUSH P,UUOH
TLNE R,(20←33) ;THE NCALL BIT
PUSH P,[UUONVL]
JSP R,UUOX4B
SKIPN V.RSET
JRST UUOS6Q
PUSH P,FXP ;IF IN *RSET MODE, MAKE
HRLM FLP,(P) ; UP AN EVAL FRAME (SEE EVAL
MOVEI C,(A) ; FOR FORMAT THEREOF)
HRRZ B,40
PUSHJ P,XCONS ;MUST CONS UP FAKE ARG TO EVAL
PUSH P,A
HRLM SP,(P)
PUSH P,[$EVALFRAME]
MOVEI A,(C)
UUOS6Q: PUSH P,TT ;PUSH OF FUNCTION
MOVEI TT,IAPPLY
JRST ILIST
UUOS11: MOVEM T,UUOFN ;*** FSUBR CALLED LIKE LSUBR
MOVE T,UUTSV
JRST UUS10A
;;; ENDCODA [EXPR ← FSUBR]
UUOS3: LDB TT,[270400,,40] 3*** FEXPR CALLED LIKE SUBR
UUOS4A: SOJN TT,UUOFER
UUOEX2: MOVEI TT,1 ;*** FEXPR CALLED LIKE FSUBR
DPB TT,[270400,,40]
TLOA A,400000
UUOS: SKIPA TT,40 ;*** NONATOMICFUN AALLED LIKE SUBR
UUOEXP: HLRZ TT,(T) ;*** EXPR CALLED LIKE SUBR
LDB T,[270400,,40]
UUOEX4: MOVE R,40 ;ALL OF T,TT,R WILL BE LOST!
TLZN TT,-1 ;INSERT EXPR NAME IF WAS EXPR
HRL TT,R
TLNN R,1000
PUSH P,UUOH
MOVN T,T
SKIPE V.RSET
PUSHJ P,UUOBNC
TLNE R,(NCALL)
PUSH P,[UUONVL]
JSP R,UUOX4B
PUSH P,TT ;PUSH FUNCTION
JUMPE T,IAPPLY
MOVEM T,UUTSV
HRLZ R,UUTSV
MOVE A,1(R)
JSP T,PDLNMK
PUSH P,A ;PUSH ARGUMENT
AOBJN R,.-3
MOVE T,UUTSV
JRST IAPPLY ;APPLY FUN TO ARGS
UUOS10: MOVEM T,UUOFN ;*** FSUBR CALLED LIKE SUBR
JSP TT,ARGPDL
UUS10A: AOJN T,UUOFER
POP P,A
MOVSI T,2000
IORM T,40
MOVE T,UUOFN
JRST UUOSBR
UUL2N: SKIPA TT,40 ;*** NONATOMICFUN CALLED LIKE LSUBR
UUOS5: HLRZ TT,(T) ;*** EXPR CALLED LIKE LSUBR
MOVE T,UUTSV
CAMGE T,XC-NACS
JRST UUOS5A
JSP R,PDLARG
MOVNS T
JRST UUOEX4
UUOS5A: PUSH FXP,T ;DAMN CASE WHERE WE MUST
PUSH FXP,V.RSET ; SLIDE STUFF UP THE PDL,
MOVEI R,(P) ; DOING PDLNMK'S AS WE GO
JSP T,NPUSH-3-NACS+1 ;ROOM FOR ALL ACS BUT A, PLUS 3
SKIPE (FXP)
JSP T,NPUSH-5 ;EXTRA SLOTS FOR *RSET
MOVEI D,(P)
MOVE F,-1(FXP)
UUOS5B: MOVE A,(R) ;SO DO ALL THE PDLNMK'S
JSP T,PDLNMK
MOVEM A,(D)
SUBI R,1
SUBI D,1
AOJL F,UUOS5B
HRL TT,40 ;TT HAS BEEN SAVED - HAS FN
MOVEM TT,(D) ;SAVE FUNCTION BELOW ARGS FOR IAPPLY
SKIPE (FXP) ;D SHOULD POINT TO WHERE ACS ARE SAVED
SUBI D,5 ;FOR *RSET, MUST SAVE THE ACS UNDER THE FRAME!
REPAAT NACS-1, MOVEM B+.RPCNT,.RPCNT-NACS(D) ;SAVE ALL MARKED ACS BUT A
MOVEI TT,R5M1PJ ;PROVIDA FOR RESTORING THEM
MOVEM TT,-1(D) ;ACS WERE SAVED UNDER, NOT OVER, THE
MOVE TT,40 ; FRAME IN CASE OF AN FRETUBN
MOVE F,UUOH ;MAYBE NEED RETURN ADDRESS UNDER
TLNE TT,1000 ; THE ARGS (IF NOT, USE A CPOPJ)
MOVEI F,CPOPJ
MOVEM F,-NACS-1(D)
POP FXP,F
JUMPE F,UUOS5C 9IAYBE EORE *RSEP HAIR?
PUCH FXP,(FPP) ;DUPLACATE NUMBEROF ARGS ON FXP
MOVEI TT,4(D) ;DT POINTS TO THE FIVE *RSET SDOTS
MOVEM TT,-DQ
! $∩∩w↓1∨ A!=∪≥) HA∪≥)<A! _↓'→∨(4∀∪!+M⊃∀A 1++∨
U_∩∩wM (A+@Aβ!!13
%β5
@Q!=!&A
a R~∀%!∨ A→1 Y)P~∀∪⊃I%5&@!)(R∩$w
→+M⊂Aπ!=!∀@Z↓∪β!!12A/∪1_Aπ%∃β)
A=≥
~∀%∃%'(↓∪β!!12~∀~)++∨&Uεt∪!= A
1@Y(∩∩m≥∨.A→∨$A)!
A∪βA!→2~(∪∃%'PA∪β!A→2∩∩m++∨
U_A/β9)&A)]≡A)⊃%≥∂&A=≤A
1@XA/∪1_A!∨@A∨≥
4∀_~∀~)β%∂π!⊗t∪π¬≠∂
APY1ε[9βπ&∩mπ⊃ π,A≥+≠ $A∨_Aβ%∂LA'+!A→∪ λ4∀∪∃%M(A!β∃%$∩∩m$A⊃βLAβ)∨4A!%∨A %)2↓→∪'(↓!∨∪≥Q $~∃¬%∂→π,t∪'↔%!
A,9%' (4∀∪∃%M(Aβ%≥π⊗d~)β%∂π,bt∪!= A YQ(∩∩w→∨$A'A λX↓ ≡A)!∪&A%¬)⊃ $↓)⊃β≤4∀∪∃%M(@bQQ(R∩∩mβ∨&@! R@AA∨!∀A@X~∀~)β%∂π,dt∪'-∨)(AHY'2∩$w$A⊃¬&A'35¬∨_A=$A'βH~∀∪∃I'(AβI∂π⊗j$∩w≠+M(A¬
↓αA'βH~∃β%≥π⊗`t%⊃→%4↓$XQ$$~∀∪⊃1%4A$0bQ$R4∀∪∃+5!
A$1β%∂π,b~∀∪1 ∧A)PY6bbDb``X1%:~∀%∃+≠!8A)(Y¬%∂π⊗L~∃β%≥π⊗ht%→ ∧AQ(Y6`@bb``0Y%:~(∪≠∨-9∩A)(0ZbQ)PR~∀∪
β≠≤APY)(~(∪β∨&Q R~(∪!∨!(A X~(~∃β%≥π⊗ft%≠∨-≥$A)(X4bQ)($~∀∪π¬≠→
APY)(~(∪!∨!(A X~(∪→ ∧↓)(Y6@`bb`@XY%:4∀∪πβ%≤A)(0nnn∩$vnnn↓∪&A →
π)%- →2↓∪≥
∪9∪)2~(∪∃%'PA!∨!(b~∀∪5∨-≥∩↓)(XZDQ)(R4∀∪πβ5_A(YQ(~∀∪¬∨&@Q@R~∀∪A∨!∀A@X~∀~)β%∂π,jt∪→⊃∧A$Ym))' %~XY)Q'β$QHS:~∀%β∨∃α↓$Yβ%≥π⊗h~(~∀~∃¬%∂! 0t∪→ λA(Y6Hn`h`@XXhat∩wβ%≥&@z|↓! _@[π≥(t|A(~(∪≠∨-9&A(~)β%∂ @t∪⊃%14A$YP~∃β%≥ bt∪)+≠!
↓$XQ)PR~∀∪A+'⊂A@YαQ$$~∀∪β=¬∃≤AHX\Zb4∀∪∃%M(@Q)PR~∀~)! →βI∞t∪π¬≠∂
APY1ε[9βπ&~)!β %Ht∪→ I$A ≠Lbl∩w5∨%
AQ⊃β≤@TAβ%∂L~∀∪∃I'(@\,bW≥β
&Q(R4∃% !∃β(A≥¬π&Y7
∨≥εAI')$YpyαZb-≥βπ&4]%!π9(|Xt%!∨ A@YαZb-≥βπ&4]%!π9(~∃:4∃! →∧dt∪∃I'(@QHR~∀∪5∨- ∩↓λY#'U¬%πβ1_∩wπ=≠
A⊃∃%
A∪_A'+¬Iπβ→_Q"],8RA∂∨P@`AβI∂&~∀%'∨∃α↓(Y/≥¬→∨'
4∀_~∀~)')%)=+(t~(∪'+¬$A(Y'Q%)>ZLf∩∩w→→β∞A9∨≤[5∃%≡A∪_A')%PnAπβ1_~∀∪∃1π⊂APY++)M,~∀∪A+'⊂A@Y++∨ ∩∩w!U'⊂A%∃)+%≤↓β $↓
∨$A→∪≥β_↓ 1∪(4∀∪!+M⊂A Y∧~∀∪!U'⊃∀A@Y'β-`j~∀∪A+'⊂A→1 Y+U)',~(∪!+' A
1 0h`~∀%!+'⊂↓ Yβ$D~∀∪!U'⊂A 1β$eα4∀∪→ λAλY6Hn`h`@XXQ
a S:∩mβεzb\A≠ β9&A+'∀A≠'∂→∪→ &8~∀∪π¬∪≤Aλ0bn~∀$A∃%'PA % Aλ~∀∪M↔∪!≤↓β$bX!λR∩∩m≥∪_A5 β≥&↓+'
A⊃
β+1(A=$↓β≥λAy.~∀∩↓∃%'(↓ % a ~∀∪π¬∪≤AβHbY#+9¬∨+≥⊂∩w∂∪Y ≤A+9¬∨+≥⊂A-β%%β¬→
|~∀∩A1 %$Am'∪1¬%(A9+9¬∨+≥⊂A-β%%β¬→
↓∪≤A!I∪≥εA→%∨~A
∨≠!∪1 λAπ=
@@4[∂'∧¬9:~∃∃% a
h∪)→≡↓β$bXH````@~∃ %@a t∪5∨- ∩↓αXQβHbR~∀%→'⊂A∧X[' ≥→∨∞~(∪'↔∪A_A'(!αR∩∩m≠β3¬∀A'⊃∨U→λA I%$[π! π⊗A )) H}~∀∩↓)→≡A¬$bXh@````$∩w≥∨Q
A/⊃∃)⊃ $↓→∪'(↓∨$A≥=(~∃ I aαt%∃' APY∂)%⊃)∧~∀$\k→∨
↔∩~∃∃%¬!→=εzzZD∩∩∩w1∨πβ)%∨≤A∨_A¬3)∀A!)$↓∨≤A
a! _~) $o!1∨εzz4d∩∩∩m→∨πβQ∪∨≤A= A')I(n[ ↓∨≤A
a! _~(∪'↔∪A
A $]!→∨ε!
1 R$∩w')I(n[ |~∀∩A)%'(A∃% oα4∀∪≠∨Y'∩Aλ0hh`l@`~∀∪!→→~A⊂Y %¬A→∨εQ→1 R~) % bh∪∪→ λA)(Y∃%¬!→=εQ
1@R∩w'Q%∪≥∞↓¬3)
↓!∨∪≥Q $A∪LA')∨I λA∨8A
1 4∀∪πβ%≤A)(0NF∩wQ⊃
@\U→∨π↔$A'β-∃λA∪≥!∪¬∪(↓∨≤A)= A∨ ↓
1 ~(∩A∃%M(A %@f~∀∪
β∪≤AQ(XNB4∀∩A∃I'(A I l~∀%πβ∪≤↓)(XOx~∀∩A)%'(A∃% h~) % jh∪β $A)(XP`~∃ I kαt%!+'⊃(A Y'Q%)3≡4∀∪∃%M(A %@b~∀~) % o∧t∪≠∨Y'∩Aλ0hh`n@`~∀∪!→→~A⊂Y %¬A→∨εQ→1 R~) % nh∪∪→ λA)(Y∃%¬!→=εQ
1@R∩w'Q%∪≥∞↓¬3)
↓!∨∪≥Q $A∪LA')∨I λA∨8A
1 4∀∪∃+5!
A)PY % X~∀∪!U'⊃∀A@Y')%Q3≡~∀%∃%'(↓ % n4∀~∀~) % a⊂t∪'↔%!≤AβHbY-≠M∂
∪→∃&~∀∪)%'(A∃% mα4∀∪∃%M(A %@a
~∀4∃ % Aεt∪'-∪!
A¬$bY)¬!/%(4∀∪⊃%I4Aβ$DY-∨+Q
∪→ L~∀∪∃U≠!≤A¬$bY I a ~(∪'↔∪A
A))e∨
~(∪∃%'PA % Yα~∀∪)%'(A∃% aα4∀~∃ I ft∪%→ ∧AQ(Y % !→∨ε!
1 R$w#+∨Q
AαA
⊃β$~(∪∃%'PA % T~∀~∃∃% ht%∪→ ∧↓)(Y I¬!→∨ Q
1 $∩wπ∨9)%∨→1∪
2A∧Aπ⊃βH~∀∪β⊃ ∩A)PXh`~(∪)%ε↓)(Xb@`~∀∪
β∪
AQ(Y=~4∀∩A∃I'(A I kα~(∪!+'!∀A YM)%)3<~∀∪≠=- ∩AQ(Y=∀4∀∪∃%M(A %@kα~∀4∃ % Xt∪+≥1∨π↔∩$∩w ∨9
B~∃∃% mαh∪!∨ ↓ Yβ$Iα~∀∪A∨ A 1β$b~(∪'+∧↓
1 YHn`Vd$w
→+M⊂A¬3Q
A!)HAβ≥λ↓')%(] A'/%)π⊂~(∪!∨ ↓ Yα∩$w% 'Q∨%
A∧~∀∪∃I'(A%M)0j∩m% ')=%
A≥U≠βπ&↓β≥λAA∨!∀~(~∃ ≥⊃
+≤zt\Zb∩9'
AM'3')∃~∩w≥<A≠∨%∀A
+≥
)∪∨≥LA¬ 3=≥λA⊃∃%
~∀_~∃'U¬))_%∪≥∪)%β_A'Qβ%)+@Aπ∨ ∀~∀~∀lvvA≥=%≠β_7∞A'Qβ%)+@Aπ∨ ∀\@A∨8A
∪%M(A%+8XA)⊃∀Aβ→→=εA!⊃¬'
Aπ=≠ &A! %
v4∀vvv↓)⊃ %∃β
) HXA→∪M!∂≡A
∨≠ &↓⊃ %
↓ ∪%
)→2\4∀vvv↓/
A <A≥∨(↓⊃β-
↓)⊃
AU'
A∨_A)⊃
↓! →&↓+≥)∪0A)⊃
↓πβ→_↓)≡A I∪≥∪08~∀vvlA/
A⊃≡A≥∨PA⊃β-∀A)⊃
↓+'
A= Aπ∨9'∪≥∞↓∨ Aβ92A'∨I(A+≥Q∪_A)!
Aπβ1_A)≡↓∂π≥%P\~∀~)→∪' h∪≠∨-9∩A)(0b∩∩w¬∨¬∃≤↓∨≤@ZDA→ βY &A6DXXa:↓∨≤Aα↓↔αb`4∀∪β∨ ∃≤A)PX\Vb$∩vA¬U(A6atA∨≤A∧@A↔_↓∨$A↔$~∀∪≠=- ~AQ(Y↔αDa ~∀mπ→ βHAβ≥λ↓ ∪'β →
A∪9) %%U!(A'e') ~4∃∪
≤↓∪!&Yl~∀∪!%∨≤~∀$]'+'∃(A6]M!∪%# XY$nA:~∀∩9'+' PA6]'%
!∪$0Y$nat~∀∩]M+' (↓6]%∨A)∪∨≤0Y)):4∀∪)→<A)(Y=!)∪≥PW∨!)=!ε∩w9 .['Q3→
A%≥) %I+!)&↓β≥λA9≡A!ε↓'π% ]β∂
~(∩]'+M (A69'∨!)%∨≤XYQ):~∀%)→≥≤↓)(Y∨A)¬%⊗$∩w∪ ↓∨+$AM+! %%∨$Aπ1β∪≠&↓)≡A⊃¬≥ →
↓¬% β-&X~∀$A∃%'PA→∪'@bn∩∩l@Aβ≥⊂A∪ A%(Aπ→¬∪≠&AQ≡A⊃βY
A→∪M O&AM3≠¬∨0A)β¬1
~∀∩9¬% β,@bdYl\]%'Q XY)Q:∩vAYβ→% PAαA'Q%∪≥∞↓)≡Aπ¬+'
@lLA)3A ∨+(↓≠∨
4∀∪'↔%!∂
AQ(∩∩v↓)≡A¬∀A&[ a A)3A ∨+(Qβ≥λ6JA)<A¬
AM#+∨5∀R~∀∩]-β→U
A7βMπ∪4@<.u∪ ↓≤@u'e≠)3 ↓ J~∀lP\])¬≠!8~(\])!∃%86cD~∀\]Qβ≠!9@J~∀6$u- @=:~∃→%' bnh~∃:∩$w ≥λ↓∨ A∪→≤A∪)L~∀~∃%
≤AλD`Txb5'β∪_xX∪∃'@A(YλDa' (4∀d`H∪∃' ↓$Y)≥a' (∩$@@@@m π∪⊃
A/⊃%π⊂A∨A'3&@4A) ≥∃0A∨$↓)∨!&H`~∀∩$∩∩@@@vAβ9λA
∪`A+ AAβ∂
A¬ππ 'M∪¬∪→%)3&~)∪
≤AU' → M&Ty∪Q'9λd@|XA∃M A(YM⊃β% @@wπ∨9'∪ HA'⊃βI∪≥∞AAβ∂ &↓/∪)⊂↓∨)⊃ HA∃∨¬L~∀~∀%!∪∨≤$w ≥β →
A∪9) %%U!)&~(~∀w%∃' (A$←≡A']∪)π⊃∃&~∀∪M )5~↓)β!/I(∩∩wU/%∪)∀A
→β≤@Q=$$~∀∪'∃)5~AQ)3∨
_∩∩w Q2A∨+Q!+(A→→β∞@!=.R~)∪
≤A)∨¬#∪<Y6~∃%(H∩]⊃))2∩$∩w'βdA)⊃∪LA∃∨∧↓+β≥)LA)⊃
↓))2X↓%β)⊃∃$~∃∪PH∩A∃→π_∩∩$rA)⊃¬≤A→ Q)∪≥∞↓β≤A∪9
%∪=$A⊃βY
A∪(4∃∪(J%/β%≤↓7% )I∪ -
↓))2A→%∨~ANFERIOR?]
] ;END OF IFN JOBQIO
;RESET FREELISTS TO FORCE A CLEAN GARBAGE COLLECTION
REPEAT NFF, SETZM FFS+.RPCNT ;SET FREELISTS TO NIL
IFN HNKLOG+DBFLAG+CXFLAG, MOVSI A,(SETZ)
IFN HNKLOG,[
REPEAT HNKLOG+1,[
SKIPN HNSGLK+.RPCNT ;HACK TO AVOID CREATING
MOVEM A,FFH+.RPCNT ; UNNEEDED HUNK SEGMENTS
] ;END OF REPEAT HNKLOG+1
] ;END OF IFN HNKLOG
DB$ SKIPN DBSGLK ;DITTO FOR WEIRD NUMERIC TYPES
DB$ MOVEM A,FFD ;THE SETZ BIT IN THE FREELIST
CX$ SKIPN CXSGLK ; POINTER MEANS IT IS OKAY TO
CX$ MOVEM A,FFC ; HAVE NO FREE CELLS AS LONG AS
DX$ SKIPN DXSGLK ; NO ONE TRIES TO CONS ONE
DX$ MOVEM A,FFZ
SETZM GCTIM ;RESET GC TIME (SINCE RUNTIME PROBABLY GOT RESET?)
SETZM ALGCF ;RESET ALLOC FLAG - OKAY TO GC NOW
JSP T,TLVRSS ;RESET VARIOUS "TOP LEVEL VARIABLES"
JSP A,ERINIX ;SET UP PDLS, RESTORE MUNGED DATA, ENABLE INTERRUPTS
;INITIALIZE DEFAULT DIRECTORY NAMES
JSP T,PPNUSNSET
;TRY TO OPEN THE TERMINAL AS AN I/O DEVICE
PUSHJ P,OPNTTY
JFCL
;PERFORM INITIAL GARBAGE COLLECTION (BUT DON'T BOTHER TO COMPACT ARRAYS)
MOVSI T,111111
PUSHJ P,GCNRT
PUSHJ P,UDIRSET
;INITIALIZE CURRENT UNIT
;INITIALIZA VARIOUS BIZARRE TOP-LEVEL VARIABLES
MOVEI T,INR70
MOVEM T,VTTSR
MOVEI A,Q. ;INITIAL VALUE OF * IS *
MOVEM A,V.
MOVE A,VERRLIST ;SET UP FOR EVAL'ING ERRLIST
MOVEM A,VIQUOTIENT
SKIPGE AFILRD
JRST LSPRET
LIHAC: SETOM AFILRD ;HAIRY HAC TO READ, THE FIRST TIME
MOVEI A,TRUTH ; AROUND, FROM THE .LISP. (INIT) FILE
MOVEM A,TAPRED ;(SETQ ↑Q T)
JRST HACENT
IFN ITS,[
LISP43: SETZ
SIXBIT \SSTATU\
REPEAT 5, 2000,,TT ;IGNORE USELESS GARBAGE
402000,,TT ;MACHINE NAME
] ;END OF IFN ITS
10$ WAKTTY: JRST (T)
SUBTTL PPNUSNSET UDIRSET TNXSET D10SET
PPNUSNSET:
IFN D10,[
SA% GETPPN TT, ;FOR TOPS10/CMU, USE GETPPN
SA% JFCL ; (GETS PPN OF CURRENT JOB)
SA$ SETZ TT, ;FOR SAIL, WE PREFER DSKPPN
SA$ DSKPPN TT, ; (AS SET BY THE ALIAS COMMAND)
MOVEM TT,USN
MOVEM TT,TTYIF2+F.PPN
MOVEM TT,TTYOF2+F.PPN
] ;END OF IFN D10
IFN ITS,[
MOVE TT,IUSN
MOVEM TT,TTYIF2+F.SNM
MOVEM TT,TTYOF2+F.SNM
] ;END OF IFN ITS
JRST (T)
;INITIALIZE THE NAME OF THE MACHINE IN THE FEATURES LIST
;INITIALIZE (STATUS UDIR)
UDIRSET:
MOVE TT,BPSH ;IF BPEND SOMEHOW
CAMGE TT,@VBPEND ; IS LARGER THAN BPSH,
PUSHJ P,BPNDST ; SET IT EQUAL TO BPSH
IFN D10,[
PUSHJ P,SIXJBN ;INITIALIZE TEMP FILE NAME D10NAM
IFE SAIL,[
MOVEI A,QTOPS10
SKIPE CMUP
MOVEI A,QCMU
] ;END OF IFE SAIL
] ;END OF IFN D10
IFN ITS,[
.CALL LISP43 ;GETS NAME OF ITS (AI, MC, ML, DM) IN TT
.VALUE
SETZ A, ;CONVERT TO ATOMIC SYMBOL
HLRZS TT
IRP X,,[AI,ML,MC,DM]
CAIN TT,(SIXBIT \X\)
MOVEI A,Q!X
TERMIN
SKIPN A
.VALUE
] ;END OF IFN ITS
SA% HRLM A,SITEFT ;SET UP (STATUS FEATURES) FOR SITE NAME
IFN D10,[
IFE SAIL,[
CAIN A,QCMU
JRST .+3
HRRZ A,SITEFT ;Can't figure out a specific site name, so just
HRRM A,OPSYFT ; splice it out, and let the generic name do.
MOVNI T,1 ;FOR NON-SAIL, TRY TO GET
SETZB TT,D ; DEFAULT SNAME BY USING PATH.
MOVEI R,0
MOVE F,[4,,T]
PATH. F,
] ;END OF IFE SAIL
MOVE D,USN ;ON FAILURE, JUST USE USN
MOVE TT,D ;PPNATM EXPECTS PPN TO BE IN AC TT
PUSHJ P,PPNATM
] ;END OF IFN D10
IFN ITS,[
MOVEI A,0
;;; Following will be done by (STATUS UDIR)
;;; MOVE TT,IUSN ;TAKE INITIAL SNAME
;;; PUSHJ P,SIXATM ;CONVERT TO ATOMIC SYMBOL
] ;END OF IFN ITS
IFN ITS\D10,[
MOVEM A,SUDIR
POPJ P,
] ;END OF IFN ITS\D10
IFN D20,[
SKIPE TENEXP
SKIPA 3,[440700,,[ASCIZ \DSK:<MACLISP>SITE.TXT\]]
HRROI 3,[ASCIZ \PS:<MACLISP>SITE.TXT\]
HRROI 1,[ASCIZ \LISP:\]
STDEV ;IS THERE A LISP: DEVICE?
SKIPA 2,3
HRROI 2,[ASCIZ \LISP:SITE.TXT\]
UDRS5: HRLZI 1,(GJ%SHT+GJ%OLD)
GTJFN
JRST UDRS2A
MOVE 3,1
MOVE 2,[<07←36>+OF%RD] ;ASCII BYTES
OPENF
JRST UDRS1A ;WILL HAVE SOMETHING IN 2
MOVNI T,<LPNBUF-1>*BYTSWD
MOVE TT,PNBP
UDRS4: BIN
JUMPE 2,UDRS1 ;HAS 0 IN 2 WHEN JUMPING
IDPB 2,TT
AOJL T,UDRS4
HALTF
UDRS1: MOVE 1,3
CLOSF
JFCL
JRST UDRS1B
UDRS1A: MOVE 1,3
RLJFN
JFCL
UDRS1B: MOVNI T,BYTSWD
IDPB 2,TT ;PADD OUT WITH 0'S
AOJL T,.-1
PUSHJ P,PNBFAT
HRLM A,SITEFT
UDRS2: SETZB 1,2
SETZ 3,
MOVEI A,QLISP
MOVEI B,QPPN
PUSHJ P,REMPROP
HRROI 1,[ASCIZ /LISP:/]
SKIPN TENEXP
STDEV ;IS THERE A LISP: DEVICE?
JRST UDIRSX
MOVEI 1,.LNSJB ;IF SO, GET THE LOGICAL TRANSLATION
HRROI 2,[ASCIZ /LISP/]
MOVE 3,PNBP
LNMST
JRST .+2
↓JRST UDIRS6
MOVEI 1,.LNSSY
HRROI 2,[ASCIZ /LISP/]
MOVE 3,PNBP
↓LNMST
JRST UDIRSX
UDIRS6: MOVE D,PNBP
MOVE F,[440700,,T]
SETZ T,
MOVNI R,5 ;PICK UP ASCII FOR REAL DEVICE IN T
UDIRS7: ILDB TT,D
JUMPE TT,UDIRSX
CAIN TT,":
JRST UDIRS8
IDPB TT,F
AOJL R,UDIRS7
JRST UDIRSX
UDIRS8: ILDB TT,D
CAIE TT,"<
JRST UDIRSX
MOVE R,PNBP ;SHUFFLE DOWN THA "<MACLISP>" PART
UDRS8A: ILDB TT,D
JUMPE TT,UDIRSX
CAIN TT,">
JRST .+3
IDPB TT,R
JRST UDRS8A
PUSH FXP,T
MOVNI T,5
SETZ TT,
IDPB TT,R ;FILL OUT WITH A WORD OF NULLS
AOJLE T,.-1
PUSHJ P,PNBFAT
PUSHJ P,NCONS
PUSH P,A
POP FXP,PNBUF
SETZM PNBUF+1
PUSHJ P,PNBFAT
POP P,B
PUSHJ P,CONS
SKIPA B,A
UDIRSX: MOVEI B,Q%ALD ;HAS (PS MACLISP) In it, for default case
SKIPE TENEXP ;OR (DSK MACLISP) foR tenex systems
MOVEI B,Q%HALD
MOVEI A,QLISP
MOVEI C,QPPN
JRST PUTPROP
UDRS2A: HRRZ A,SITEFT 9Since we can't figure out a specific site
HRRM A,OPSYFT ; name, just splice it out, and let the generic
JRST UDRS2 ; name from OPSYSTEM-TYPE do.
] ;END OF IFN D20
IFN D20,[
9;;CALLED WITH JSP D, TO SET UP TENEXP. REDURNS WIPH FLAG IL A AS WELL
;;9 Must save R -- seE JCLSET
TNXP: MOVE A,[112,,11] ;MUST BA CALLED UHEN INTERRUPTS ARE OFF
GETTAB A,
JRST TNXST9 ;LOSE IF GE CANT DECID@
B~(∪→ ∧↓αY6bPb```0Yβ:∩$rfA
=$A) 9 0H@PA
∨$↓)∨!&4b`~∀%'+¬∩↓αXd~(∪πβ∪∀AαXb4∀∩A≠=) ∩A∧Y≥∪_4∀∪≠∨Y ~Aα1) ≥ a ~∀∪)%'(@!λR~∀$~∃)≥a' (t%∃' A⊂Y)≥1@∩∩∩wM )+ ↓) ≥ a A
→¬∞XA%∃)+%≤↓∪≤Aα4∀∪≠∨Y ∩Aλ0b∩∩∩m% ≠∨⊃ _Aπ
∨εdA ∪)&A→∨$A≥|~∀∪≠=) ∩AλY#)∨A&d`~(∪∃+≠A
AαX8Vf~∀$A≠∨-∃∩AλXL~∀αA5∨- ∩↓∧Y#)∃≥ 0~(∪ !∧↓λY6b@`d``0Yππ∨
.e*~(∪≠∨-∀AλYπ
∨π.d4∀∪≠∨Y ~Aλ1))3∪_dW)∩9'(d~(∪⊃%→4A∧Y∨A'3
λ4∀∪⊃%1~A∧YM∪)
P∩∩∩wU ∪%'∃(A'⊃=+→λA5∨ ∪
dA)⊃∪L~∀β≠=- ∩AQ(Xc>Dn\['∃∂'∪5∀Vb~∀%' )54A))3% dW)$]'(j4∀∪' Q5~A-Q&da 4∀∪∃+5!≤Aα1)≥1'Pf@∩∩$sαA'Q∪→_A!β&A)∃≥ 1 4∀∪≠∨EI 1,.PRIIN
RTCHR
ERJMP TNXST3
SETOM VTS20P ;GET TERMINAL-CAPABILITIES-WORD
MOVEM 2,TTYIF2+TI.ST5 ;IF ON A TWENEX
TNXST3: MOVEI D,(TT)
LSH D,-SEGLOG ;GET SEGMENT NUMBER
HLL D,ST(D)
TLNE D,ST.$NX
JRST TNXST1
MOVSI A,.FHSLF
HRRI A,(D) ;GET PAGE NUMBER
JSP T,IPURE$ ;MAKE SURE PAGE EXISTS
AND B,[PA%RD+PA%WR+PA%EX+PA%CPY]
TLO B,(PA%RD) ;LET IT BE READABLE
TLNE D,ST.LS+ST.FX+ST.FL+ST.BGN
TLZA B,(PA%EX) ;DONT EXECUTE FROM DATA AREAS
TLO B,(PA%EX)
TLNE D,ST.PUR
JRST TNXST2
TLNE B,(PA%CPY) ;WHY WOULD BOTH PA%CPY AND PA%WR
TLZA B,(PA%WR) ; BOTH BE ON???
TLNN B,(PA%WR) ;IF ALREADY WRITEABLE, DONT MAKE
TLO B,(PA%CPY) ; COPYABLE
JRST TNXST4
TNXST2: TLZ B,(PA%CPY+PA%WR) ;NOT WRITEABLE, IF A "PURE" PAGE
SKIPN PSYSP ; PSYSP is override
TLO B,(PA%CPY)
TNXST4: SPACS
TNXST1: SUBI TT,SEGSIZE
JUMPG TT,TNXST3
JRST (R)
] ;END OF IFN D20
IFN D10*<1-SAIL>,[
D10SET:
; MOVE TT,[%CCTYP] ;KA 10 VS KL/KI 10 ?
; GETTAB TT,
; JRST .+4 ;DO RUNTIME TEST IF ENTRY NOT THERE
; CAIE TT,.CCKAX
; MOVEI TT,0
; JRST .+3
; MOVNI TT,1 ;AOBJN ON -1 LEAVES [1,,0] ON A KA10
; AOBJN TT,.+1 ; BUT [0] ON A KL OR KI
; MOVEM TT,KA10P
SETZM MONL6P
SETZM CMUP
MOVEI A,QTOPS10
HRLM A,OPSYFT
;MAYBE SOMEDAY WE COULD FIGURE OUT THE ARPA HOST NAME HERE???
HRLM A,SITEFT
MOVE A,[%CNMNT] ;GET MONITOR TYPE WORD
GETTAB A,
MOVEI A,010000 ;ASSUME TOPS-10 IF GETTAB ENTRY NOT THERE
LDB A,[.BP CN%MNT,A] ;1 = TOPS-10, 2 = ITS, 3 = TENEX, 6 = TOPS-20
SOJE A,.+3 ;REAL TOPS-10 SYSTEM, RATHER THAN SIMULATOR?
SETZB A,SGANAM ; ON VARIOUS SIMULATIONS, DONT KILL HISEG
JRST (T)
MOVE A,[%CNVER]
GETTAB A, ;GET MONITOR LEVEL NUMBER
MOVSI A,5
LDB A,[140600,,A]
CAIN A,6
SETOM MONL6P
MOVE A,[%CNFG0]
GETTAB A,
MOVE A,[ASCIZ \CMU10\]
CAME A,[ASCIZ \CMU10\]
JRST (T)
SETOM CMUP
MOVEI A,QCMU
HRLM A,OPSYFT
;MAYBE SOMEDAY WE COULD FIGURE OUT THE ARPA HOST NAME HERE???
HRLM A,SITEFT
JRST (T)
] ;END OF D10*<1-SAIL>
¬
SUBTTL JCL INITIALIZATION ROUTINE
;;CALLED WITH RETURN ADDR IN ACC F
;; JCLSET imagines that the job was started with some commmand line, and
;; tries to strip off the subsystem name from the TOPS-20 version
;; SJCLSET gets the entire RSCAN line
JCLSET:
IFN D20,[
TDZA R,R
SJCLSET: MOVEI R,1
] ;END OF IFN D20,
SETZM SJCLBUF ;FIRST WORD OF BUFFER IS COUNT
MOVE 1,[SJCLBUF,,SJCLBUF+1]
BLT 1,SJCLBUF+LSJCLBUF-1
IFN D10,[
MOVE R,[440700,,SJCLBUF+1]
SA% RESCAN
SA$ RESCAN A
SA% CAIA
SA$ SKIPN A
JRST JCST3
JCST4: INCHRS B
JRST JCST3
CAIE B,↑M ;IF <CR> OR <ALT> OCCURS ON COMMAND
SA% CAIN B,33
SA$ CAIN B,175
JRST JCST3 ;BEFORE A ";", THEN NO JCL
CAIE B,";
CAIN B,"(
CAIA
JRST JCST4 ;LOOP UNTIL WE FIND A ; OR (
MOVNI D,BYTSWD*LSJCLBUF
JCST2: INCHRS A
JRST JCST1
CAIN B,"( ;IF JCL STARTED WITH A (,
CAIE A,") ; ONLY UP TO THE ) IS JCL,
CAIA ; BUT WE MUST GOBBLE THE WHOLE LINE
SETO B,
JUMPL B,JCST5
AOSG D
IDPB A,R
JCST5: CAIN A,↑M ;<CR> OR <ALT> TERMINATES
JRST JCST1 ;THE COMMAND LINE
SA% CAIE A,33
SA$ CAIE A,175
JRST JCST2
JCST1: SKIPLE D
TDZA D,D ;TOO MUCH JCL => NONE AT ALL
ADDI D,BYTSWD*LSJCLBUF
JCST3: INCHRS A ;MAKE SURE NO SUPERFLUOUS CHAR
JFCL
MOVEM D,SJCLBUF
SETZ A,
IDPB A,R ;INSURE AT LEAST ONE NULL BYTE FOLLOWING THE LINE
JRST (F)
] ;END OF IFN D10
IFN D20,[
JSP D,TNXP
MOVEI 1,.RSINI ;ACTIVATE THE COMMAND LINE AS INPUT
SKIPN TENEXP
RSCAN
JRST (F)
MOVEI 1,.RSCNT ;ANYTHING THERE?
RSCAN
JRST (F)
JUMPE 1,(F)
MOVEM 1,5 ;# OF CHARS KEPT IN AC 5
MOVEM 1,4
JUMPN R,[ MOVE 3,[440700,,SJCLBUF+1]
JRST SJCL1C ]
MOVEI 3,NIL ; IF NON-(), SAYS ALREADY PASSED ONE "WORD"
MOVE T,[440700,,PNBUF]
JCL1A: SOSGE 5
JRST (F)
PBIN
JUMPE 1,(F)
CAIN 1,↑M ;LOOK FOR SPACE OR CR TERMINATING SUBSYSTEM
JRST (F) ; NAME.
CAIN 1," ; LOOP, TO FLUSH THIS WORD
JRST [ JUMPN 3,JCL1B
MOVEI 3,TRUTH
SUB 4,5
CAIE 4,4 ;LOOK FOR "RUN ", AND IF FOUND
JRST JCL1B ; THEN FLUSH IT AND TAKE ONE
IDPB 1,T ; MORE WORD, WHICH SHOULD BE
IDPB 1,T ; THE SUBSYSTEM NAME.
MOVE T,[ASCII \RUN \]
AAMN T,PNBUF
JRST JCL1A
JRST JCL1B ]
CAIN 1,";
JRST JCL1B
IDPB 1,T
JRST JCL1A
JCL1B: SETZM SJCLBUF
MOVEI 1,"
MOVE 3,[440700,,SJCLBUF+1] ;AH! PUT IN AN INITIAL SPACE
IDPB 1,3
AOS SJCLBUF
JCL1C: SOSGE 5
JRST (F) ;LOOP, UNTIL RUN OUT OF RSCAN CHARS
PBIN ;MOVE RSCAN BUFFER TO OUR ADDRESS SPACE
CAIL 1," ; CHECK FOR #\SPACE
JRST [ CAIN 1,";
JRST JCL1B
IDPB 1,3
AOS SJCLBUF
JRST JCL1C ]
MOVEI 2,0
CAIE 1,↑V ;CONVERT CONTROL-CHARS, EXCEPT ↑V, TAB, CR, AND LF
CAIN 1,↑I ; TO NULLS
MOVE 2,1
CAIE 1,↑M
CAIN 1,↑J
MOVE 2,1
IDPB 2,3
JUMPE 1,(F) ;TERMINATE ON A TRUE NULL BYTE
AOS SJCLBUF
JRST JCL1C
] ;END OF IFN D20
SUBTTL INTERNAL PCLSR'ING ROUTINES
SFXTBL: ;TABLE OF LOCATIONS FOR SFX HACK
MACROLOOP NSFC,ZZM,*
SFXTBI: ;TABLE OF INSTRUCTIONS NORMALLY IN THOSE LOCATIONS
MACROLOOP NSFC,ZZN,*
PROTB: ;TABLE OF INTERRUPT PROTECTION INTERVALS
MACROLOOP NPRO,PRO,*
;;; TABLE MUST BE AN EXACT POWER OF TWO IN LENGTH SO WE CAN
;;; USE SUPER-WINNING BINARY SEARCH METHOD.
HAOLNG LOG2NPRO,<.-PROTB-1>
REPEAT <1←LOG2NPRO>-NPRO,[ INTOK,,777777
] ;END OF REPEAT <1←LOG2NPRO>-NPRO
;;; IT IS OBVIOUSLY USELESS TO USE PROTECT MACROS BEYOND THIS POINT.
;;; EXPUNGING NPRO WILL CAUSE AN ERROR IF THE PROTECT MACROS ARE USED
EXPUNGE NPRO
;;; PUSHJ FXP,$IWAIT
;;; CALLED FROI WITHIN A NORMAL INTERRUPT HANDLER TO DECIDE
;;; WHETHER IP IS SAFE TO ISSUE A USER INTERRUPT.
;;; ON FAILURE, STACKS UP THE INTERRUPT AND SKIPS.
;;; AS FOR UINT0, D CONTAINS THE INTERRUPT DESCRIPTOR WORD.
;;; INTERRUPTS MUST BE DEFERRED; PDL OVERFLOW MUST BE
;;; ENABLED. THE CONTENTS OF INTPDL POINTS TO THE INTPDL ENTRY
;;; FOR THE CURRENT INTERRUPT, WHICH CONTAINS THE SAVED
;;; CONTENTS OF D AND R. FXP MUST BE IN A USABLE STATE.
$IWAIT: HLRZ R,NOQUIT ;IF IN GC, WE ARE IN A BAD STATE
JUMPN R,IWSTAK ; AND SO MUST STACK THE INTERRUPT
HRRZ R,INTPDL
CAIE R,INTPDL+LIPSAV ;FOR NESTED PI LEVEL (E.G. PDL OVERFLOW),
JRST IWSTAK .SEE INTXIT ; ALSO STACK THE INTERRUPT
MOVEI R,(SP) ;IF THE SPECPDL IS IN SOME
MOVE F,(SP) ; KIND OF STRANGE STATE (E.G.
CAME R,ZSC2 ; INTERRUPTED OUT OF SPECBIND)
CAMN F,SPSV ; THEN MUST DO THE INTSFX HACK
JRST IWLOOK
INTSFX: MOVE F,[PUSHJ FXP,SPWIN]
MOVSI R,-NSFC .SEE SFX
MOVEM F,@SFXTBL(R) ;CLOBBER LOCATIONS MARKED BY SFX SO
AOBJN R,.-1 ; SFXPRO'ED ROUTINE WILL RETURN TO SPWIN
HRRZ F,INTPDL ;RESTORE AC'S, AND SAVE
EXCH D,IPSD(F) ; INTERRUPT DESCRIPTOR
MOVE R,IPSR(F)
PUSH FXP,IPSPC(F) ;GET PC AND FLAGS
MOVEI F,IPSF(F)
PUSH FXP,F
MOVE F,(F)
JRST 2,@-1(FXP) ;CGNTINUE WHATEVER WE WERE DOING
;;; RETURN FROM SFX HACK. ROUTINE HAS DONE PUCHJ FXP,SPWIN.
SPWIN: MOVEM F,@-1(FXP) ;PRESERVE F
HRRZ F,INTPDL
POP FXP,IPSPC(F) ;PUT PC BACK INTO INTPDL FRAME,
SOS IPSPC(F) 9 BACKED UP TO THE CLOBBERED INSTRUCTION
SUB FXP,R70+2
MOVEM R,IPSR(F) ;SAVE ACS D AND R
EXCH D,IPSD(F)
MOVSI R,-NSFC
SPWIN1: MOVE F,SFXTBI(R) ;RESTORE THE LOCATIONS THAT WE
MOVEM F,@SFXTBL(R) ; CLOBBERED WITH PUSHJ FXP,SPWIN
AOBJN R,SPWIN1
JRST IWWIN ;WE HAVE WON
IWLOOK: HRRZ F,IJTPDL ;FAST BIJARY SEARAH OF PROTECT
HRRZ R,IPSPC(F) ↓; TABLE ON PC @∪≥Q %%+A) λA→%∨~~(∪!+π A
! 1λ~∧∪5∨% ∩↓λX`~)% ! ¬(A→∨≤e≥!¬<Y6~∀%≠↔-
↓ Y!¬=)∧VxE>y→∨≤e≥!%<Z]%!
≥(Zbx|QλR4∀∪πβ%_A$X! R~∀$Aβ $AλXc|y→∨∞I→!%≡4]%!π9(Zb|4∃:∩∩m ≥λA= A% A β(A1∨∞e≥A%≡~∀%≠∨-&↓$Y!%=)∧Qλ$~∀∪!= A
1@Yλ~∀%⊃%%4↓ Y∪≥Q! _∩$wαA+M
+_↓-β→+∀A
∨$↓ ~∀∪)%'(@!$R∩∩m∂≡A)<A!→β
A/⊃%π⊂A⊃¬≥ → LA)⊃∪LA∪≥)∃%-β_4∀~∀vlvAπ∨5
A⊃ I
A)≡↓≠∨-
↓)⊃
AAεA
∨I/β%λ↓∨+(A= AαAA%∨)
) λA%≥) %Yβ_~∀lvvA¬dA 1
+)∪≥≤A∪≥)∃%- ≥%≥∞A∪9')%+
)∪∨≥L\@A)!
AβπLAβ%
↓π∨%%∃π)→24∀vvv↓β-β∪1β¬→
↓ +%∪9∞A)⊃%&A 1∃π+)∪=≤XA aπ !(↓
1 \A)⊃
↓!εA
1β∂&A¬%
~∀lvvA≥=(A!%∃' %-∃λ\@AQ⊃+&X↓π∨
↓∪∀A'Uπ⊂Aα↓!%∨)∃π) λ↓∪≥) I-β_AM⊃∨+→⊂~∀fvlA≥∨(↓+'
A→1 A∨HA)⊃
↓!εA
1β∂&\A≥≡A)+≠ A%≥')%Uπ)∪∨9&A≠βdA¬
AU' λv4∀vvv↓⊃∨/ Y $XAM↔∪!&↓β%
A!β≥ →∃λAπ∨I% π)12\~∀9'
Aaπ!!%<~∀~∃%≥)1πPt∪!+M⊂A
1@Y∪!'AεQ R4∀∪ 1
⊂AλY%!'λQ_R∩∩wI ')∨I
AβπLAλXAHXAβ≥⊂A ~∀%≠∨-
↓$Y∪!M$Q R$∩w
→¬∂&AβI
@U≥=(TA%∃')∨%∃λ~∀∪5∨- ∩↓ Y∪!M Q R$∩wβ→M≡XA
a A∪&↓∨+(A= A/⊃¬π⊗@Q /β%∀BR~∀%!+'⊂↓
1 Y_~∀∪≠=-
A 0Q R~(∪1π(↓ZbQ→1 R∩$w 1
+)
A¬≤A∪≥M)%+πQ∪∨≤~(∩Aπβ%α~∀∩Aβ∨&ZbQ
a R∩∩m⊃β≥ 1
A'↔%!&Aπ=%% πQ→2~∀%β∨&@4bQ
1@R~∀∪5∨- ~↓ YQ→1 R~(∪'+∧↓
1 YHn`Vb4∀∪⊃%I4A Y%≥)! 0~∀∪≠=- ~AHY∪!'HQ R~(∪ 1π AλY∪A'λQ $~∀∪!= A
1@Y∪!'AεQ R4∀∪∃%M(A∪/1∨∨⊗∩$w≠β2↓≥ λ↓)≡A1
(A'∨5
A≠∨I
~∀_~∀~)∪≥)'e t∪'=&A≥!→
2d∩$]'
↓'3π∨9&~∃∪9)'3"h∪'∨&↓≥!
dd~∃∪9)'30h∪≠∨-∃∩A$YA'3π∨9&~∀∪)%'(A%≥)¬⊗D~∀~∃%≥)%∨Pt∪⊃→I4A$YH∩∩w!I∨) πPAπ∨ ∀A∨ AQ⊃
A
=%~~∀%'+¬∩↓$Xb∩$v∪%∨PAαX[M ∂→∨≤~∀∪%=(AαYM ∂→∨≤∩∩v∩@@\\8A≠+≥
⊂@\\8~∀∪∃I'(A∪9)¬⊗b$∩v∪%=(AαYM ∂→∨≤~∀~∃%≥)!! t∪⊃→I4A$YH∩∩w!I∨) πPA!+%∀Aπ∨≥M $~∀%'+¬∩↓$Xb∩$w¬βπ,A+ AQ≡A)⊃∀Aβ∨'0A∨$A]⊃β) Y $~∀%⊃%%~↓$Y∪!M!εQ $~∀∪'=&AQHR∩∩wI ')∨I
A)⊃∀Aπ∨+9) $~(∪∃%'PA∪≥)=⊗~∀~)∪≥)εI0t∪⊃1%~A∧1α∩∩w5+'(AA%∨)
(A→ →(A⊃β1 A∨ ↓∧A
∨HAπ∨≥L~∀∪≠=- ∩AHYπ∨≥Lb∩∩w!β∪%2↓↔∪≥λ↓∨ A¬¬π↔+ ↓
∨$A
∨≥&~(∪∃%'PA∪≥) ⊗b~∀4∃∪≥) e2t∪!→%~AλYα∩∩m≠+'(↓!%∨)∃π(A→∃
(A⊃¬→ A∨_A∧A
=$Aπ∨9&~∀∪5∨- ∩↓$XKπ=≥&b∩$w⊃β∪I2A↔∪9λA∨ ↓¬βπ↔U A
∨HAπ∨≥L~∀∪∃I'(A∪9)¬⊗b4∀~∃∪9)βπ(h∪⊃%%hA$Y+U)',∩$]'
↓++∨β
_~∀∪)%'(A%/→∨∨,~∀~∃%≥))3`t∪⊃→I4A$YH∩∩wβI%β≥∂∀A)≡A≥≡A)≡↓∪≥))e$XA/!∪π⊂A]∪→_~(∪!+' A Y$$∩vA∂∃(A)⊃∀A))'¬$A¬β
⊗A∪≥Q~A(X↓)⊃ ≤↓!∨!∀4∀∪≠∨Y ∩A$1∪≥))e$∩∩]M
A)e∨1π(↓)3∪1
(A)3%πβ_~(∪⊃%%i&A∪≥!∪¬∪($∩]' ∀@\k→-)∨!∨A∀~∀∪)%'(A%≥)¬⊗D~∀~∃%≥)βπ`t∪≠∨Y'&Aα$∩]' ∀Aβπ∨9&∩vQI ')∨I &Aα↓
∨$A βπ↔+@R~∀∪5∨- ∩↓$Yβπ=≥&∩∩m≠β↔
↓)⊃∪&↓)⊃
A9 .A! ~∀∪∃I'(A∪9)¬⊗b4∀d`H↓∪≥)'1 t∩∩$w
∨$↓∪≥) I%+!(↓
%∨~↓λd`AM→ 0A≠+'PA
→+M⊂@Eαλ~∃∪≥Q5β0t%' )4↓αX∩∩$wπ∨≥M %&A]⊃∪π⊂↓ ∨≤OPA!%∨Q π(AQ⊃ ∪$↓
% 1∪'(B4∃∪≥) β⊗t∩↓⊃→%4↓$Y$∩$w¬βπ,A+ AAεA)≡↓¬ ∂∪9≥∪≥∞4∃∪≥) ⊗bt∪!%%~AHY∪!'AεQ R$∩vA∨_A∪≥)∃%-β_4∃∪≥)=⊗t∪)14A$X4b~∃⊃LH@b`⊂∪πβ∪0A$Y⊃M∂∨%∞$∩w≥≡↓β%%βe&A∪≤↓⊃∪∂⊂↓' ∂≠∃≥(B~)⊃&H@D`H∩A)%'(A%//∪≤4∀∪πβ5_A$Y↓-¬! 9λ~∀∩↓∃%'(↓∪≥)'→0~∃∪]/∪≤t%⊃%%4↓ Y∪≥Q! _∩$w/
A!β-
A]∨≤B~(∪!∨!(A
1 0~∀~∀lvvA≥∃ λA/∀A!∪∨_Aβ%∨U≥λA)!∪&@A)'$A+%')β⊗@}}@↓
]∞\↓/⊃β(↓β¬∨+PA≠ ≠∃%$}~(~∃∪/M)β⊗t%∃'$AU∪')β,∩∩w/∀Aβ%
↓∪≤Aα↓¬βλAM)β)
ZZ~∀%β∨&@!
1 R$∩vA'Qβπ⊗AU A)⊃∀A∪≥)∃%%+!P~∀∪∃I'(A∪]/∪≤~(~∀~∀%!∂)∨@A∪≥(17∪≥)∃%%+!PAβ≥λ↓++≡A!β≥ →∃%':~(_~∀~)'+¬)Q_∪!βQπ⊂AβI αXAM)%+πPA∪≥'∃%(XA ∪(A)¬¬→ &0Aβ≥λ↓'!βπ∀Aπβ→
+→β)%∨≥&~(~∀~∃Aβ)π⊂h@A!βPt@A1Aβ)π⊂h∩~∀∪ →∨π⊗↓!)π'%4~∀~)!β∂ U ~∀∪∃!β)π zz\ZD~∃∪≥→∨%~Am→ ≥∂Q⊂A∨ ↓!β)π Aβ% ∧@zA;q !β)
⊂[!βQπ⊂~∀4∃!∞J%¬'3'M∞z{⊃%→∨ε[M) ⊃∩$wπ%∨
⊗@ZA /β%∀A% →=πβ)∪=≤B~∃M!π)∨@A'3&0Y7'3M) ≠:4∃!∞J% 1!+9∂
A¬M3''∞4∃≥!+I!∞zzp\[¬!U%!∞|=!β∂'%4~∀~(b`H∩⊃→∨' ≤~∀~∃%≥+~zt\~∀~(~∀I∪9'%(AM)%+πP∩∩w∪9∪)∪β0A→∪'PA')%Uπ)+%∀~∀~∀lvv@b@H∪≥∨\A∪≤@(TA→∨\A' ∂5 ≥(@(T~∀~(~∀~∃9¬∪)∧t{≥∪
M'∞W≥%
1'∞-≥∪
→M∞W≥¬9'∞~∀@@A5hzzxy9¬∪)∧,b|U¬Q¬'∪4-' ∂'%4Zb|=' ∂'%4~∃∪→≤A545¬)'∂≥&Y6~(@@@A]β%≤Am≥ ∃λA≥+5¬ $A= A∪≥%)∪β_↓¬∪(AQβ¬→
↓' ∂≠∃≥)&@!;95416RA = '≤OP@~∀∪5β)π⊂↓∂+ 'L\@Q¬Q'∂∂&u;9¬)M∂∂&YlR~∃:4∃:∩∩m ≥λA= A∪
8A54[ )'∂∂L~∀~∀9β→'≡] %$4∀~∃∪→≤A→∨ ∪)'∞0∪¬
¬Q¬&{¬Q¬→↔&-≥¬∪)λU¬)¬M∪4~∀9 →'
16∩∩∩$∩∩vvlA≥∨)∀A/ →0BA
∪I'(A
LA' ∂5 ≥(A≥ )&A→∪%'(~∀∩∩$∩∩∩vlvA¬∪PA¬→∨K! (SEE NUNMRK, GCP6)
SPCBOT BIT
BTBLKS: -1 ;THIS WILL BE RESET BY GCINBT
BLOCK NBITB*BTBSIZ-1
BFBTBS: ;BEGINNING OF FREE BIT BLOCKS
PAGEUP
SPCTOP BIT,ST,[BIT BLOCK]
] ;END OF .ELSE
NBPSSG==1*SGS%PG ;INIT WILL MUNG ST AND PURTBL ANYWAY TO PRESERVE ALLOC
NFXPSG==1*SGS%PG ;PDL AREAS FOR INIT AND ALLOC
NFLPSG==1*SGS%PG
NPSG==1*SGS%PG
NSPSG==1*SGS%PG ;ALLOC ALTERS ALL PDL PARAMETERS!!!
IFN PAGING,[
NXFXPSG==1*SGS%PG
NXFLPSG==1*SGS%PG
NXPSG==2*SGS%PG
NXSPSG==2*SGS%PG
IFE SFA,[
IFN ML, NSCRSG==2*SGS%PG
.ELSE NSCRSG==3*SGS%PG ;ALLOW FOR PDP6 PAGE (P6)
] ;END IFE SFA
IFN SFA,[
IFN ML, NSCRSG==1*SGS%PG
.ELSE NSCRSG==2*SGS%PG ;ALLOW FOR PDP6 PAGE (P6)
] ;END IFN SFA
;;; NUMBER OF NON-EXISTENT MEMORY SEGMENTS
;;; (TAKE ALL OF CORE AND SUBTRACT OUT EVERYTHING USEFUL!!!)
NNXMSG==NSEGS
IRP SPC,,[ZER,ST,SYS,SAR,VC,XVC,IS2,SYM,XXA,XXZ,SY2,PFX,PFS,PFL,XXP
IFS,IFX,IFL,BN,XXB,BIT,BPS,FXP,XFXP,FLP,XFLP,P,XP,SP,XSP,SCR]
NNXMSG==NNXMSG-N!SPC!SG
TERMIN
;;; DETERMINE ORIGINS FOR ALL SPACES ABOVE THIS POINT
ZZX==.
IRP SPC,,[BPS,NXM,FXP,XFXP,FLP,XFLP,P,XP,SP,XSP,SCR]
B!SPC!SG==ZZX
ZZX==ZZX+N!SPC!SG*SEGSIZ
TERMIN
SPDLORG==MEMORY-<NSCRSG+NSPSG+NXSPSG>*SEGSIZ
PDLORG==SPDLORG-<NPSG+NXPSG>*SEGSIZ
FLPORG==PDLORG-<NFLPSG+NXFLPSG>*SEGSIZ
FXPORG==FLPORG-<NFXPSG+NXFXPSG>*SEGSIZ
] ;END OF IFN PAGING
IFE PAGING,[
ZZX==.
IRP SPC,,[FXP,FLP,P,SP,BPS]
B!SPC!SG==ZZX
ZZX==ZZX+N!SPC!SG*SEGSIZ
TERMIN
SPDLORG==BSPSG
PDLORG==BPSG
FLPORG==BFLPSG
FXPORG==BFXPSG
] ;END OF IFE PAGING
SUBTTL APOCALYPSE (END OF THE WORLD)
;FOR REL ASSEMBLIES, INIT AND ALLOC CODE OVERLAP INITIAL BPS
10$ LOC BBPSSG
$INSRT ALLOC ;INITIALIZATION AND ALLOCATION ROUTINES
PRINTX \
\ ;JUST TO MAKE LSPTTY LOOK NICER
EXPUNGE ZZ ZY ZX ZZX ZZY ZZZ ZZW
HS$ 10$ IF2, BSYSSG==HSGORG ;ANTI-RELOCATION CROCK
IF2, MACROLOOP NBITMACS,BTMC,* ;FOR BIT TYPEOUT MODE
ENDLISP:: ;END OF LISP, BY GEORGE!
VARIABLES ;NO ONE SHOULD USE VARIABLES!
IFN .-ENDLISP, WARN [OKAY, WHO'S THE WISE GUY USING VARIABLES?]
IFN D10,[
$HISEG
ENDHI:: ;END OF HIGH SEGMENT
] ;END OF IFN D10
IF2, ERRCNT==:.ERRCNT ;NUMBER OF ASSEMBLY ERRORS
END INITIALIZE